#! /usr/bin/perl

use strict;

use File::Find ();
use Env qw(JR_HOME JR_RMIC_CACHED JR_ECHO CLASSPATH OS OSTYPE);

my $OSdelim;
my $OSsep;
# set $OSdelim and $OSsep based on what Java we're using,
# i.e., what Java expects in CLASSPATH.
# (this works for Cygwin assuming Java installed within Windows, not Cygwin)
if(defined($OS) && $OS =~ /Windows/) {
    $OSdelim = ";";
    $OSsep = "\\";
}
else {
    $OSdelim = ":";
    $OSsep = "/";
}

my $OSopen;  # how environment variables are denoted (start delimiter)
my $OSclose; # (end delimiter)
# set $OSopen and $OSclose based on what $OS we're running
# and what Perl we're using.
# Perl installed under Cygwin needs UNIX-style
# since they are used on command line with Cygwin.
# Perl installed under Windows needs Windows-style.
my $archname;
$archname = `perl -V:archname`;
if(defined($OS) && $OS =~ /Windows/ && $archname !~ /cygwin/) {
    $OSopen = "%";
    $OSclose = "%";
}
else {
    $OSopen = "\$";
    $OSclose = "";
}

use Sys::Hostname;
use Cwd;
use File::Path; # for mkpath and rmtree

my $jrc;
my $jrrun;
my $javac;
my $java;
my $jr_rmic;
my $which;
my $cmp;
my $cmpNoCR;
my $sort;
my $grep;
my $tail;
my $host;
my $result;
my $testcase;
my $verb;
my $args;
my $out;
my $rest;
my $code;
my $ofile;
my $ifile;
my @subs;
my $line;
my $ccr2jr;
my $csp2jr;
my $m2jr;
my $prog;
my $arg1;
my $arg2;
my $JRT_JAR;
my $JRX_JAR;
# impossible since args can't start with blanks
my $CPinit = " I'm imPossible x5!234  ";
my $CPsaved = $CPinit;
my $CPoriginal;
# impossible since args can't start with blanks
# note: $RCinit is used by jr_rmic, mustn't be a directory name...
my $RCset = 0;
my $RCinit = " I'm imPossible x9!678  ";
my $RCsaved = $RCinit;
my $ECHOset = 0;
my $ECHOinit = " I'm imPossible 543!x9  ";
my $ECHOsaved = $ECHOinit;

use Getopt::Long;


# process command-line options.
my $ph = 0; # print header info
my $print = 0;
# exit with the exitstatus of last command that differed from expected.
# (used typically when testing just one program repeatedly until it fails.)
my $lcexitstatus = 0;
my $exitstatus = 0; # exitstatus
my $startDir = 0;
my @excludeDirs;
my $u = 0; # use standard UNIX tools for grep, etc.

GetOptions('v' => \$print,
            'h' => \$ph,
            's' => \$lcexitstatus,
            'd=s' => \$startDir,
            'x=s' => \@excludeDirs,
            'u' => \$u)
|| die "$0: problem processing command line options\n";

# would be nice to add "-j jarfile" option
# to facilitate testing of new versions of JR.
# however, the tools that jrv calls (e.g., jrc) set jar file too,
# not that simple.

# only directories named on command line (no -v, -d, -x args)
my @dirs = @ARGV;


$ph || print "\nStarting JRV\n";

# Check to see if JR_HOME has been defined
if ( !$JR_HOME ) {
    $! = 1;
    die "$0 requires environment variable JR_HOME\n" .
        "to be set to the absolute pathname of JR's home\n";
}

# Make sure directory that JR_HOME refers to exists and is readable
if ( (-e $JR_HOME) != 1 || (-r $JR_HOME )!=1 ) {
    $! = 1;
    die "$0: environment variable JR_HOME set to " .
        $JR_HOME .
        "\nbut that directory does not exist or is not readable\n";
}

# Get the programs we will be calling.

if($OS =~ /Windows/) {
	$which = "perl \"".$JR_HOME."/bin/which.pl\"";
}
else {
	$which = `which which`;
	chomp($which);
}

$cmpNoCR  = "perl \"".$JR_HOME."/bin/cmpNoCR.pl\"";

if (! $u) {
    # use special cmp for Cygwin with Perl installed under Cygwin
    if(defined($OS) && $OS =~ /Windows/ && $archname =~ /cygwin/) {
        $cmp  = $cmpNoCR;
    }
    else {
        $cmp  = "perl \"".$JR_HOME."/bin/cmp.pl\"";
    }
    # we'll use these for both Windows and Linux
    # (even though we could use native Linux versions).
    $grep = "perl \"".$JR_HOME."/bin/grep.pl\"";
    $sort = "perl \"".$JR_HOME."/bin/sort.pl\"";
    $tail = "perl \"".$JR_HOME."/bin/tail.pl\"";
}
else {
    # use standard UNIX tools.
    # this is useful to verify that our versions (above)
    # do the same as the standard UNIX and that the Script
    # files don't require anything whose behavior differs
    # between the two sets of tools.
    # (arguably, these should be environment variables...)
    $cmp  = "cmp";
    $grep = "grep";
    $sort = "sort";
    $tail = "tail";
}

$jrc = "perl \"".$JR_HOME."/bin/jrc\"";
$jrrun = "perl \"".$JR_HOME."/bin/jrrun\"";
$jr_rmic = "perl \"".$JR_HOME."/bin/jr_rmic\"";
$javac = `$which javac`;
chomp($javac);
$java = `$which java`;
chomp($java);
#### 2003-08-15 below fixes Windows for Aaron (and works on UNIX too),
#### but need to consider this problem in general,
#### e.g., for JR_HOME, other env. vars., etc. and in other tools (../bin/*)
$javac = "\"".$javac."\"";
$java = "\"".$java."\"";

$ccr2jr = "perl \"".$JR_HOME."/bin/ccr2jr\"";
$csp2jr = "perl \"".$JR_HOME."/bin/csp2jr\"";
$m2jr = "perl \"".$JR_HOME."/bin/m2jr\"";

# if not set by command-line option, set to default.
$startDir || ($startDir = $JR_HOME."/vsuite");

## Mostly for debugging purposes
$ph || print "JR_HOME= $JR_HOME\n";
$ph || print "JRC=     ".$jrc."\n";
$ph || print "JR_RMIC= ".$jr_rmic."\n";
$ph || print "JRRUN=   ".$jrrun."\n";
$ph || print "JAVAC=   ".$javac."\n";
$ph || print "JAVA=    ".$java."\n";
$ph || print "ccr2jr=  ".$ccr2jr."\n";
$ph || print "csp2jr=  ".$csp2jr."\n";
$ph || print "m2jr=    ".$m2jr."\n";
$ph || print "WHICH=   ".$which."\n";
$ph || print "CMP=     ".$cmp."\n";
$ph || print "GREP=    ".$grep."\n";
$ph || print "SORT=    ".$sort."\n";
$ph || print "TAIL=    ".$tail."\n";

## list JR version number
$ph || system("$jrc -version");
if ( $? ) {
    die "$0: problem getting version from $jrc\n";
}
$ph || system("$jrrun -version");
if ( $? ) {
    die "$0: problem getting version from $jrrun\n";
}

##Set usmak
umask(0002);

##Get hostname
$host = hostname();

##Check to make sure a hostname was found
if ( !$host ) {
    $! = 1;
    die "Can't figure out hostname\n";
}

##Print some information for the user
$ph || print "HOST= $host\n";
$ph || print "Start Directory= ".$startDir."\n";

##Set the JRT_JAR and JRX_JAR variables
$JRT_JAR = setjarvar( "JRT", "jrt.jar");
$JRX_JAR = setjarvar( "JRX", "jrx.jar");

##Set CLASSPATH and chdir to the vsuite
##Because Windows and Unix uses a different separator for the classpath
##the OS is checked to see what type it is and sets the separator based on
##that. The OS is also printed out.
if($OS =~ /Windows/) {
	$ph || print "Operating System= ".$OS."\n";
}
else {
	$ph || print "Operating System= ".$OSTYPE."\n";
}

if(defined($CLASSPATH)) {
    $ph || print "original CLASSPATH= ".$CLASSPATH."\n";
    $CPoriginal = $CLASSPATH;
}
else {
    $CPoriginal = "";
    warn "\n$0: environment variable CLASSPATH not set;\n";
    warn "    multi-VM JR programs likely won't work\n\n";
    # they could work if, e.g., CLASSPATH set in .cshrc but not in shell
    # that's running jrv.
}

####$CLASSPATH = "." . $OSdelim . $JR_JAR;
$CLASSPATH = "." . $OSdelim . $JRT_JAR
                 . $OSdelim . $JRX_JAR;

$ph || print "jrv sets CLASSPATH= ".$CLASSPATH."\n";

use Time::localtime;
$ph || print "DATE= ".ctime()."\n";

# remember directory in which jrv began
# so -d can use relative pathname, e.g., `jrv -d .'
my $here = cwd;

mustchdir($startDir);

##Find all the Script files full path names in the directories passed in from
##the command line. If no arguments were passed in then search
##the entire vsuite

use vars qw/*name *dir *prune/;
*name  = *File::Find::name;
*dir   = *File::Find::dir;
*prune = *File::Find::prune;

if (@dirs) {
    File::Find::find( { wanted => \&wanted }, @dirs );
}
else {
    File::Find::find( { wanted => \&wanted }, '.' );
}

########################################## what's \z/s mean????????????????????
sub wanted {
    if (/^Script$/) {
        my $subdir = $name;
        $subdir =~ s/\/Script$//;
##print "$name $subdir\n";
	push @subs, $subdir;
    }
}

##print "@subs\n";
##exit;

## This main loop. Each iteration will run one of the Script files

foreach my $subd ( sort @subs ) {

    # change to where began jrv, so relative pathnames work with -d option.
    # (don't combine with next cd so that absolute pathnames work too.)
####my $zz = cwd;
####print "pwd=$zz\n";
####print "here=$here\n";
    mustchdir($here);

    my $temp1 = $subd;
    # drop any leading ./ on pathname
    $temp1 =~ s/^\.\///;

    my $skip = 0;
    # is this one of the excluded directories?
    foreach my $i ( @excludeDirs ) {
	# see whether this subd has $i as a pathname prefix
	# would be smarter to compute @x once ...
        my @x = split( '/', $i );
        my @s = split( '/', $temp1 );
## print "$#x and $#s\n";
	if ($#x <= $#s) {
	    $skip = 1;
	    for (my $k = 0; $k <= $#x; $k++) {
		if(@x[$k] ne $s[$k] ) {
		    $skip = 0;
		    last;
		}
	    }
	}
	if( $skip == 1 ){
	    last;
	}
    }
    if( $skip == 1 ){
	next;
    }

####print "subd=$subd\n";
    mustchdir($startDir."/".$subd);
    print $subd. ":\n";

    ## Open up the script file
    open(SCRIPT, "Script") ||
        die "$0: cannot open $subd Script\n";

    my $disablerm = 0; # keep intermediate files around on some errors
    ## This while loop iterates through each line of the Script file
    ## and executes the commands
    while ( $line = <SCRIPT> ) {

	  ## If the line is a comment then move on
        if ( $line =~ /^\s*#/ ) {
            next;
        }


        # handle any continuation lines (\ as last character)
	# by making them all one big line.
        # (handle comments above so don't
        # treat \ within comment as continuation.)
        while ($line =~ s/\\$//) {
	    chop($line);
            $line = $line . <SCRIPT>;
        }

	  ## If the line is all whitespace or a comment then move on
          ## (tested above for a comment, but can have blank line
          ## continue into a comment; weird, but OK I guess.)
        if ( $line =~ /^\s*$/ ||  $line =~ /^\s*#/ ) {
            next;
        }
	  ## Parse the line
        ( $code, $verb, $args ) = split / /, $line, 3;
        chop($args);

	if( $print == 1) {
	    print $line;
	}

	if($OS =~ /Windows/) {
	   $args =~ s/\/dev\/null/NUL/g;
	}

	  ## If jrc then run jrc with the args
        if ( $verb =~ /^jrc$/ ) {
           `$jrc $args > Translator.out 2>&1`;
	   $result = $?>>8;
        }

	  ## If javac then run javac with args passed in
        elsif ( $verb =~ /^javac$/ ) {
            `$javac $args> Compiler.out 2>&1`;
            $result = $?>>8;
        }

	  ## If jr_rmic then run jr_rmic with the args
        elsif ( $verb =~ /^jr_rmic$/ ) {
           `$jr_rmic $args > JR_RMIC.out 2>&1`;
	   $result = $?>>8;
        }

        elsif ( $verb =~ /^ccr2jr$/ ) {
            `$ccr2jr $args>CCR.out 2>&1`;
        }

        elsif ( $verb =~ /^m2jr$/ ) {
            `$m2jr $args>M.out 2>&1`;
        }

        elsif ( $verb =~ /^csp2jr$/ ) {
            `$csp2jr $args>CSP.out 2>&1`;
        }

        elsif ( $verb =~ /^rm$/ ) {
            if (! $disablerm) { # only if not disabled
		my $tempargs = $args;
		# remove -rf artifact.
		# (Perl v5.6.0 needs \s otherwise " " is first value in loop.)
		# (doesn't hurt in v5.8.0)
		$tempargs =~ s/-rf\s//g;
		while ( <${tempargs}> ) {
		    # print "$_\n";
#		    rmtree($_,0,1);
# 2003-09-22
# 3rd param 0 or 1 doesn't seem to matter with deleting mypkg.jar problem
# on Windows.
		    rmtree($_,0,0);
	        }
		$? = 0; # above rm always works?
	    }
	    else {
		# pretend rm worked as expected (to prevent later message)
		$? = $code << 8;
	    }
        }

	elsif ( $verb =~ /^cmp$/ ) {
	    `$cmp -s $args 2>&1`;
	}

	elsif ( $verb =~ /^cmpNoCR$/ ) {
	    `$cmpNoCR -s $args 2>&1`;
	}

	elsif ( $verb =~ /^grep$/ ) {
	    `$grep $args 2>&1`;
	}

	elsif ( $verb =~ /^tail$/ ) {
	    `$tail $args`;
	}

	  ## if cd then call chdir to the given directory
        elsif ( $verb =~ /^cd$/ ) {
            mustchdir($args);
	    $? = 0; # mustchdir succeeded
        }

	elsif ( $verb eq "jrrun") {
####	    my $tempargs = $args;
####	    $tempargs =~ s/\"/\\\\\\\"/g;
####		#print $tempargs."\n";
####	    `$jrrun $tempargs`;
	    `$jrrun $args`;
	}

	  ## if run then set up correct output files
	  ## Slight modfied so that if no output is sent in
	  ## then it wont try to call the input file dev/null
	elsif ( $verb =~ /^run$/ ) {

            if ( !$args ) {
                print "$0 No program specified to run";
            }
            else {
                ( $prog, $args ) = split / /, $args;
                $prog =~ s/\n//;
            }

            if ( !$args ) {
                $ifile = "null";
                $ofile = "No_input";
				##print "jrrun.pl ". $prog .">".$ofile.".out\n";
                `$jrrun $prog >$ofile.out 2>&1`;
            }
            else {
                ( $ifile, $args ) = split /( |\n) /, $args, 2;
                $ifile =~ s/\n//;
                $ofile = $ifile;
				##print "jrrun.pl ". $prog ." <".$ifile.">".$ofile.".out\n";
                `$jrrun $prog <$ifile>$ofile.out 2>&1`;
            }
		## Get result of run
	    #print $result."\n"; # Used for debugging
            $result = $?>>8;
		
		## If result is valid then run cmp on the output file
            if ( $result == $code ) {
                $verb = "CMP";
                $code = 0;
                `$cmp -s $ofile.std $ofile.out > jrvcmp.out`;
		$result = $?>>8;
            }

        }


        elsif ( $verb =~ /^scmp$/ ) {
            # sorted file comparison
            ( $arg1, $arg2 ) = split / /, $args;
	    my $t1 = "jrvtemp1.out";
	    my $t2 = "jrvtemp2.out";
            `$sort $arg1 > $t1`;
            `$sort $arg2 > $t2`;
            `$cmp -s $t1 $t2`;
	    $result = $?;
            rmtree(["$t1","$t2"],0,1);
	    $? = $result; # want result from cmp, not rm so below code works.
        }

        elsif ( $verb =~ /^ndcmp$/ ) {

            # nondeterministic file comparison:
            # succeeds if match one of given standard files.
            # order of args is name of generated file followed by
            # all standard files; makes code simpler.

	    ## code for this is just simplified ndscmp code from below,
	    ## but we currently don't use this, 
	    ## so we'll just make it an error for now......
	    $! = 1;
	    die "$0: ndcmp not currently implemented\n";
        }

        elsif ( $verb =~ /^ndscmp$/ ) {
                # nondeterministic sorted file comparison:
                # succeeds if after sorting match one of given standard files.
                # order of args is name of generated file followed by
                # all standard files; makes code simpler.
                # (unfortunately, scmp isn't a separate script,
                # so we repeat its code here.)
############# should make scmp a subroutine #############################
	    my $out;
	    my $rest;
            ( $out, $rest ) = split / /, $args;
	    my $t1 = "jrvtemp1.out";
            `$sort $out > $t1`;
            if ( $rest eq "" ) {
                $result = 1;
            }
            else {
		# use foreach so that get wildcard expansion
		# e.g., if $rest is "ti.std*"
		# also works if $rest is "ti.std1 ti.std2".
		my @r = split(/ /,$rest);
                foreach my $current ( <@r> ) {
		    my $t2 = "jrvtemp2.out";
                    `$sort $current > $t2`;
                    `$cmp -s $t1 $t2`;
                    $result = $? >> 8;
                    rmtree("$t2",0,1);
                    if ( $result == 0 ) {
                        last;
                    }
                }
            }
	    rmtree("$t1",0,1);
            $? = $result;
        }

        elsif ( $verb =~ /^CPuseoriginal$/ ) {
            # use original classpath.
	    # sequence should be: CPuseoriginal, ..., CPrestore
	    $CPsaved = $CLASSPATH;
	    $CLASSPATH = $CPoriginal;
	    $? = 0;
        }

        elsif ( $verb =~ /^CPprepend$/ ) {
            # prepend to classpath.
	    # sequence should be: CPprepend, ..., CPrestore
	    $CPsaved = $CLASSPATH;
	    $CLASSPATH = "$args" . $OSdelim . $CLASSPATH;
	    $? = 0;
        }

        elsif ( $verb =~ /^CPrestore$/ ) {
            # restore classpath
	    $CPsaved ne $CPinit ||
		die "$0: error in Script: " .
		    "CPrestore before corresponding CPprepend\n";
	    $CLASSPATH = $CPsaved;
	    $CPsaved = $CPinit;
	    $? = 0;
        }

        elsif ( $verb =~ /^CPjavac$/ ) {
	    # CPjavac X Y
	    # X becomes front of classpath option; Y are .java files.
	    # so above is mapped to:
	    # UNIX:    javac -classpath X:$CLASSPATH  Y
	    # Windows: javac -classpath X;%CLASSPATH% Y
	    # (Cygwin: one of above)
	    my $cparg;
	    my $rest;
	    ($cparg, $rest) = split / /, $args, 2;
	    $cparg = $cparg . $OSdelim . $OSopen . "CLASSPATH" . $OSclose;
            `$javac -classpath \"$cparg\" $rest > Compiler.out 2>&1`;
            $result = $?>>8;
        }

        # start JR_RMIC_CACHED test with caching off
        # must call in order: RCoff, RCon, RCrestore
        elsif ( $verb =~ /^RCoff$/ ) {
	    if (defined($JR_RMIC_CACHED)) {
		$RCset = 1;
		$RCsaved = $JR_RMIC_CACHED;
	    }
	    if (defined($JR_ECHO)) {
		$ECHOset = 1;
		$ECHOsaved = $JR_ECHO;
	    }
	    $JR_RMIC_CACHED = $RCinit;
	    $JR_ECHO = 1; # any value will do
	    $? = 0;
        }
        # continues JR_RMIC_CACHED test with caching on
        elsif ( $verb =~ /^RCon$/ ) {
	    my $d = cwd;
	    $JR_RMIC_CACHED = "$d/$args";
	    ## print "$JR_RMIC_CACHED\n";
	    eval { mkpath($args) };
	    if ($@) {
		print "RCon couldn't create $args: $@";
	    }
  	    $JR_ECHO = 1; # any value will do
	    $? = 0;
        }
        elsif ( $verb =~ /^RCrestore$/ ) {
	    if ($RCset == 1) {
		$JR_RMIC_CACHED = $RCsaved;
	    }
	    if ($ECHOset == 1) {
		$JR_ECHO = $ECHOsaved;
	    }
	    $? = 0;
        }

        else {
            `$verb $args`;
        }

        $result   = $?>>8;
        $testcase = $verb . $result;
####print $testcase."\n";
        if (   $testcase eq $verb . $code )
        {
            next;
        }
        if (   $lcexitstatus ) {
	    # alternatively (but is that needed or useful?):
	    # 
	    #   $exitstatus = ($code == 0)?$result:$code;
            $exitstatus = 1;
        }
	$disablerm = 1;
        if ( $testcase eq "CMP1" ) {
            print "    output differs";
        }
        elsif ( $testcase eq "CMP2" ) {
            print "    missing $ofile.std to compare output";
        }
        else {
            print "    expected $code, got $result";
        }

        if ( $verb eq "run" || $verb eq "CMP" ) {
            print " from jrrun <$ifile\n";
        }
        else {
            print " from $verb\n";
	    last; # quit this subdirectory on other error
        }
    }
    close(SCRIPT) ||
        die "$0: cannot close $subd Script\n";


}

$ph || print "DATE= ".ctime()."\n";

exit $exitstatus;


sub setjarvar {
    my $m = shift(@_); # message
    my $f = shift(@_); # jar file

    my $jar = $JR_HOME . "/classes/" . $f;
    # special case for Perl within Cygwin
    # since Java needs Windows-style CLASSPATH.
    # code after this if should work fine since Cygwin
    # allows both kinds of names.
    if(defined($OS) && $OS =~ /Windows/ && $archname =~ /cygwin/) {
        $jar  = `cygpath -w $jar`;
	chomp($jar);
    }

    ##Make sure that the file $jar points to is accessible
    if ( (-e $jar) !=1 || (-r $JR_HOME) != 1 ) {
	$! = 1;
	die "$0: $m jar file set to " .
	    $jar .
	    "\nbut that file does not exist or is not readable\n";
    }

    # Thu Aug 15 16:01:56 PDT 2002.  On CSIF, where perl -v shows:
    #    This is perl, v5.6.0 built for i386-linux
    #
    # warns about (... is pathname to lst.pl)
    #
    #     Name "main::opt_m" used only once: possible typo at ...
    #     Name "main::opt_r" used only once: possible typo at ...
    #     Can't call method "name" on an undefined value at ...
    #
    # so, we'll make that non-critical.

    my $lsout = `perl \"$JR_HOME/bin/lst.pl\" -l \"$jar\"`;
    if ( $? ) {
    ##    die "$0: problem getting ls -l $JR_JAR from lst.pl\n";
        warn "$0: problem getting ls -l $jar from lst.pl\n";
    }
    else {
	chomp($lsout);
	my @lsfields = split( ' ', $lsout );
	# note: hardwired dependent on output of above command.
	$ph ||  print "JR.$m = $jar $lsfields[11]\n";
	$lsout =~ s/$lsfields[11]$//;
	$ph || print "  $lsout\n";
    }
    return $jar;
}

sub mustchdir {
    my $dir = shift;
    if ( ! (chdir $dir) ) {
        $! = 1;
        die "$0: cannot chdir $dir\n";
    }
}
