#!/usr/bin/perl -w

# Note:	This script is released under the GNU GPL.
# 			If you find this piece of SW usefull, you may use, change, and distribute it. But please add the
#			following statement in the header of the script:
#
#				tiny_sim_checker.pl: A PERL script to scan .vhd/.vhdl design files and corresponding
#											logfiles for status of the simulation.
#											Originally released by 'berndl' at 'http://www.mikrocontroller.net/'

#
# Perl script to scan a directory for VHDL design-files and testbenches.
# In addition, logfiles are read, parsed is for a success message. This
# logfile is generated by the VHDL simulation testbench.
#
# VHDL files _must_ have a file extension '.vhd'
# VHDL testbenches must have a filename in the form 'design_tbX.vhd'
# where '_tb' is mandatory, the 'X' is optional and must be no longer
# than one character.
# Logfiles _must_ have a filename identical to the testbench with the
# extension .log, e.g. 'design_tbX.log'.
# On successfull completion of the simulation, the VHDL testbench writes
# an output string into the logfile which include exactly:
#        INFO: Testbench successfully completed
#
# The script checks for the file-dates of the testbench, included designs, and
# the logfile and generates different status messages:
#        PASSED and UP TO DATE   			: timestamps OK and success message found
#			OUTDATED									: logfile is older than any one of the included design files
#			NO LOGFILE PASS MESSAGE FOUND		: logfile exists, but there's no success message
#			NO LOGFILE FOUND						: no logfile found for particular testbench
#

use strict;

my $Directory = "./design_dir"; # or simply "." if the perl script resides in your .vhd and .log directory
#
# Find all *.vhd and *_tbX.vhd files and create logfilenames *_tbX.log
#
my @VhdFiles;           # .vhd filenames
my @VhdTbFiles;         # 1: is testbench, 0: is design
my @LogFiles;           # _tbX.log filenames

my $numVhdFiles = findVhdFiles(  \@VhdFiles,
                                 \@VhdTbFiles,
                                 \@LogFiles,
                                 $Directory);



#
# Get last file change time (seconds after 1.1.1970) for the .vhd files
#
my @VhdFilesLastChange;
chkVhdFilesLastChange(  \@VhdFiles,
                        \@VhdFilesLastChange,
                        $numVhdFiles,
                        $Directory);

#
# Check if logfiles *_tbX.log exist and get last file change time
#
my @LogFilesExist;
my @LogFilesLastChange;
chkLogFileExists( \@VhdTbFiles,
                  \@LogFiles,
                  \@LogFilesExist,
                  \@LogFilesLastChange,
                  $numVhdFiles,
                  $Directory);

#
# Check if a logfile has a message:
#           INFO: Testbench successfully completed
#
my @LogFilesPassMsg;
chkLogFilePassMsg(   \@LogFilesPassMsg,
                     \@LogFiles,
                     \@LogFilesExist,
                     $numVhdFiles,
                     $Directory);

#
# Scan all .vhd files for instantiated components
#
my @VhdFilesComponents;
scanVhdFilesComponents( \@VhdFilesComponents,
                        \@VhdFiles,
                        $numVhdFiles,
                        $Directory);

#
# Build tree for the entire design hierarchy
#
buildVhdFilesTree(\@VhdFiles,
                  \@VhdFilesComponents,
                  $numVhdFiles);

#
# The following data is now available in the arrays:
#     @VhdFiles               list of all *.vhd filenames
#     @VhdTbFiles             1: file is testbench _tbX.vhd, 0: file is design
#     @LogFiles               _tbX.log filenames
#     @VhdFilesLastChange     time of last change in seconds since 1.1.1970
#     @LogFilesExist          1: _tbX.log file exists, 0: no log file found
#     @LogFilesLastChange     time of last change in seconds since 1.1.1970
#     @LogFilesPassMsg        1: logfile has PASS message, 0: no PASS message
#     @VhdFilesComponents     string of included components in particular .vhd file
# The number of entries of each of this arrays is available in $numVhdFiles
#

my $i;

print "DESIGN files:\n";
for($i=0; $i<$numVhdFiles; $i++) {
   if($VhdTbFiles[$i] == 0) {
      printf "  %-25s", $VhdFiles[$i];
      if(length($VhdFilesComponents[$i]) > 0) {
         print "  includes: $VhdFilesComponents[$i]";
      }
      print "\n";
   }
}
print "TESTBENCH files:\n";
for($i=0; $i<$numVhdFiles; $i++) {
   if($VhdTbFiles[$i] == 1) {
      printf "  %-25s", $VhdFiles[$i];
      if(length($VhdFilesComponents[$i]) > 0) {
         print "  includes: $VhdFilesComponents[$i]";
      } else {
         print "  includes no design!";
      }
      print "\n";
   }
}
my @comparr;
my $compnum;
my $j;
print "LOG files:\n";
for($i=0; $i<$numVhdFiles; $i++) {						# loop thru all .vhd files
	if($VhdTbFiles[$i] == 1) {								# is it a testbench?
	   if($LogFilesExist[$i] == 1) {						# and does a logfile exist?
	      printf "  $LogFiles[$i]\n";
	      if($LogFilesPassMsg[$i] > 0) {
	         if($LogFilesLastChange[$i] > $VhdFilesLastChange[$i]) {
	            print "    Status $VhdFiles[$i]: PASSED and UP TO DATE\n";
	         } else {
	            print "    Status $VhdFiles[$i]: OUTDATED\n";
	         }
	         @comparr = split(/ /, $VhdFilesComponents[$i]);
	         $compnum = $#comparr + 1;
	         foreach(@comparr) {
	            for($j=0; $j<$numVhdFiles; $j++) {
	               #print "Checking $_\n";
	               if($VhdFiles[$j] eq $_.".vhd") { #$VhdFilesComponents[$j].".vhd") {
	                  #print "      Status $VhdFiles[$j]: UNDER INVESTIGATION\n";
	                  if($LogFilesLastChange[$i] > $VhdFilesLastChange[$j]) {
	                     print "      Status $VhdFiles[$j]: PASSED and UP TO DATE\n";
	                  } else {
	                     print "      Status $VhdFiles[$j]: OUTDATED\n";
	                  }
	               }
	            }
	         }
	      } else {
	         print "    Status $VhdFiles[$i]: NO LOGFILE PASS MESSAGE FOUND\n";
	      }
	   } else {
			print "  Status $VhdFiles[$i]: NO LOGFILE FOUND\n";
		}
	}
}


exit 0;  #######################################################################
                  
#
#
#
sub findVhdFiles
{
   my $VhdFiles = shift;
   my $VhdTbFiles = shift;
   my $LogFiles = shift;
   my $Directory = shift;
   my @AnyFiles;
   my @tmpsplit;
   my $numVhdFiles = 0;
   
   # find all files in the specified directory
   opendir(DIR, $Directory) || die "$Directory: $!";
   @AnyFiles = readdir(DIR);
   closedir(DIR);
   # search for .vhd files
   foreach(@AnyFiles) {
      if(index($_, ".vhd", length($_)-4) >= 0) {      # file is a .vhd file
         $VhdFiles->[$numVhdFiles] = $_;
         if(index($_, "_tb", length($_)-8) >= 0) {    # file is a *_tbX.vhd file, note that 1 wildcard-char is allowed
            $VhdTbFiles->[$numVhdFiles] = 1;
            @tmpsplit = split(/.vhd/,$_);
            $LogFiles->[$numVhdFiles] = $tmpsplit[0].".log";  # create logfile name => *_tbX.log
         } else {
            $VhdTbFiles->[$numVhdFiles] = 0;
         }
         $numVhdFiles++;
      }
   }
   return $numVhdFiles;
}

#
#
#
sub chkVhdFilesLastChange
{
   my $VhdFiles = shift;
   my $VhdFilesLastChange = shift;
   my $numVhdFiles = shift;
   my $Directory = shift;
   my $i;
   my $tmpfile;
   my @statinfo;
   
   for($i=0; $i<$numVhdFiles; $i++) {
      $tmpfile = $Directory."/".$VhdFiles->[$i];
      @statinfo = stat($tmpfile);
      $VhdFilesLastChange->[$i] = $statinfo[9];   # seconds since 1.1.1970
      #$VhdFilesLastChange->[$i] = getTimeString_sub($statinfo[9]);  # just for debugging, absolute date/time
#      printf "%-25s  Last change: %s\n", $VhdFiles->[$i], $VhdFilesLastChange->[$i];
   }
}

#
#
#
sub chkLogFileExists
{
   my $VhdTbFiles = shift;
   my $LogFiles = shift;
   my $LogFilesExist = shift;
   my $LogFilesLastChange = shift;
   my $numVhdFiles = shift;
   my $Directory = shift;
   my $i;
   my $tmpfile;
   my @statinfo;
   
   for($i=0; $i<$numVhdFiles; $i++) {
      $LogFilesExist->[$i] = 0;
      $LogFilesLastChange->[$i] = 0;
      if($VhdTbFiles->[$i] == 1) {
         $tmpfile = "<".$Directory."/".$LogFiles->[$i];
         if(open(LOGFILE, $tmpfile)) {                # true if logfile exists
            $LogFilesExist->[$i] = 1;
            close(LOGFILE);
            $tmpfile = $Directory."/".$LogFiles->[$i];
            @statinfo = stat($tmpfile);
            $LogFilesLastChange->[$i] = $statinfo[9];   # seconds since 1.1.1970
            #$LogFilesLastChange->[$i] = getTimeString_sub($statinfo[9]);  # just for debugging, absolute date/time
         }
#         print "$LogFilesExist->[$i]: $LogFiles->[$i]\n";
      } else {
         $LogFilesExist->[$i] = 0;
      }
   }
}

#
#
#
sub chkLogFilePassMsg
{
   my $LogFilesPassMsg = shift;
   my $LogFiles = shift;
   my $LogFilesExist = shift;
   my $numVhdFiles = shift;
   my $Directory = shift;
   my $i;
   my $tmpfile;
   my $line;
   my $refstring = lc("INFO: Testbench successfully completed");
   
   for($i=0; $i<$numVhdFiles; $i++) {
      $LogFilesPassMsg->[$i] = 0;
      if($LogFilesExist->[$i] == 1) {              # true if logfile exists
         $tmpfile = "<".$Directory."/".$LogFiles->[$i];
         if(open(LOGFILE, $tmpfile)) {             # true if logfile can be opened
            while($line = <LOGFILE>) {
               chomp($line);
               $line = lc($line);
               if(index($line, $refstring) >= 0) {
                  $LogFilesPassMsg->[$i] = 1;
               }
            }
            close(LOGFILE);
         } else {
            $LogFilesExist->[$i] = 0;
         }
#         print "$LogFilesPassMsg->[$i]: $LogFiles->[$i]\n";
      }
   }
}

#
#
#
sub scanVhdFilesComponents
{
   my $VhdFilesComponents = shift;
   my $VhdFiles = shift;
   my $numVhdFiles = shift;
   my $Directory = shift;
   my $i;
   my $tmpfile;
   my $line;
   my $refstring = lc("COMPONENT");
   my @tmpsplit;
   
   for($i=0; $i<$numVhdFiles; $i++) {
      $tmpfile = "<".$Directory."/".$VhdFiles->[$i];
      $VhdFilesComponents->[$i] = "";
      if(open(VHDFILE, $tmpfile)) {                # true if vhdfile can be opened
         while($line = <VHDFILE>) {
            chomp($line);
            $line = lc($line);
            if(index($line, $refstring) >= 0) {    # true if keyword found
               $line =~ s/\s+$//g ;                # remove space at end of line
               $line =~ s/^\s+//g ;                # remove space at begin of line
               @tmpsplit = split(/ /,$line);       # sort into array
               if($#tmpsplit > 0) {
                  if(index($tmpsplit[0], $refstring) >= 0) {   # true if keyword in element 0
#                     print "  $#tmpsplit: |$tmpsplit[0]|$tmpsplit[1]|\n";
                     #$VhdFilesComponents->[$i] = $VhdFilesComponents->[$i]." ".$tmpsplit[1];
                     $VhdFilesComponents->[$i] = $VhdFilesComponents->[$i].$tmpsplit[1]." ";
                  }
               }
            }
         }
         close(VHDFILE);
      }
      $VhdFilesComponents->[$i] =~ s/\s+$//g;
      $VhdFilesComponents->[$i] =~ s/^\s+//g;
#      print "$VhdFiles->[$i] contains |$VhdFilesComponents->[$i]|\n";
   }
}

#
#
#
sub buildVhdFilesTree
{
   my $VhdFiles = shift;
   my $VhdFilesComponents = shift;
   my $numVhdFiles = shift;
	my @comparr;
	my $compnum = 0;
	my $i;
	my $j;
	my $tmpVhd;
	my $idx;
	my @compSubVhd;
	my $compSubNum;

	# build array of components, 1st level
	for($i=0; $i<$numVhdFiles; $i++) {					# loop thru all .vhd files
      @comparr = split(/ /, $VhdFilesComponents->[$i]);		# which components?
      $compnum = $#comparr + 1;							# ...and how many components?
		if($compnum > 0) {									# there are further components...
			#print "$VhdFiles->[$i] has $compnum components: @comparr\n";
			$j = 0;
			while($j < $compnum) {							# loop thru all found components
				$tmpVhd = $comparr[$j].".vhd";			# construct components .vhd filename
				#print "  Checking if $tmpVhd has further components\n";
				$idx = getVhdIndex(	$VhdFiles,			# list of .vhd files
											$tmpVhd,				# .vhd file we are looking for
											$numVhdFiles);		# number of .vhd files
				#print "    Index of $tmpVhd is $idx\n";
				if($idx < 0) {
					print "FATAL ERROR: Design file $tmpVhd does not exist!\n";
					exit 1;
				}
				@compSubVhd = split(/ /, $VhdFilesComponents->[$idx]);	# get all components of indexed .vhd file
				$compSubNum = $#compSubVhd + 1;
				if($compSubNum > 0) {						# there are further components in indexed .vhd file, check if they already exist in main .vhd file
					#print "  Checking if $tmpVhd has further components\n";
					if(index($VhdFilesComponents->[$i], $VhdFilesComponents->[$idx]) >= 0) {
						#print "    $tmpVhd: Components @compSubVhd already exist in $VhdFilesComponents->[$i]\n";
					} else {										# append new components to original component string
						#print "    $tmpVhd: Components @compSubVhd added to $VhdFiles->[$i]\n";
						$VhdFilesComponents->[$i] = $VhdFilesComponents->[$i]." @compSubVhd";
						@comparr = split(/ /, $VhdFilesComponents->[$i]);	# update component array of particular .vhd file
						$compnum = $#comparr + 1;									# ...and update the number of components
						#print "    New Components of $tmpVhd: @comparr\n";
					}
				}
				$j++;
			}
		} else {
			#print "$VhdFiles->[$i] has no components, is clean\n";
		}
	}
	# print summary of dependencies
	#print "\n\n\n\n";
	for($i=0; $i<$numVhdFiles; $i++) {
		print "$VhdFiles->[$i] has components ->$VhdFilesComponents->[$i]<-\n";
	}
	print "\n\n\n\n";
}

sub getVhdIndex
{
	my $VhdFiles = shift;
	my $tmpFile = shift;
	my $numVhdFiles = shift;
	my $idx = -1;
	my $i;

	for($i=0; $i<$numVhdFiles; $i++) {
		if(index($VhdFiles->[$i], $tmpFile) >= 0) {
			$idx = $i;
		}
	}
	return($idx);
}

