#!/usr/bin/perl -w

#### reminder: this file (which resides in $JR_HOME/bin or $JR_HOME\bin)
#### is generated from files in $JR_HOME/cmds,
#### so you probably don't want to edit this file directly.

use strict;

sub u_findmain($$);
sub u_init();
sub u_jfindmain();
sub u_jgo($);
sub u_jgot(\@);
sub u_jgox($);
sub u_jr(\@);
sub u_jrc(\@);
sub u_jrfindmain();
sub u_jrgo($);
sub u_jrgot(\@);
sub u_jrgox($);
sub u_jrrun(\@);
sub u_jrt(\@);
sub u_mysystem($);
sub u_quote_args(\@);

# u_jfindmain does all the work and exits on failure.
my $basen;
$basen = u_jrfindmain();

u_init();
my $exitstatus;
$exitstatus = u_jrgo($basen);
exit $exitstatus;

#
# finds jr or java file containing main
# and then echoes that class name
#
# invoke as jrfindmain for jr files
# invoke as jfindmain for java files
#
# not perfect:
#   assumes main declaration
#     appears entirely on 1 line
#     does not appear in comments.
#     contains no comments within (e.g., "... void /*haha*/ main ...")
#   assumes the program does not have multiple main methods
#        (allowed but probably not common).

sub u_findmain($$) {
  my $suffix = shift(@_);
  my $msg = shift(@_);

  # make sure have at least one file with $suffix
  my $none = 1;
  my @suffixfiles = ("*$suffix");
  foreach my $f ( <@suffixfiles> ) {
    $none = 0;
    last;
  }
  if ($none) {
    $! = 1;
    die "$0 sees no $suffix files\n";
  }

  # build up expression for which to search

  # "void main" part
  my $v = "void\\s+main";

  # parameter parts
  # q is (String [] args)
  # r is (String args [])
  # remember to escape \, (, ), [, ]
  my $idpat = "[a-zA-Z_][a-zA-Z_0-9]*";
  my $q = "\\(\(\\s*final\\s\)?\\s*String\\s*\\[\\s*\\]\\s*$idpat\\s*\\)";
  my $r = "\\(\(\\s*final\\s\)?\\s*String\\s+$idpat\\s*\\[\\s*\\]\\s*\\)";

  my $p = "($q|$r)";

  # specifier parts
  my $s = "(public\\s+static|static\\s+public)";

  my $a = "$s\\s+$v\\s*$p";
  #######print $a;

  my $count = 0;
  my $file = ""; # set only if count>0
  foreach my $f ( <@suffixfiles> ) {
  ####  print "xxxxxxxx $f\n";
    open(F,$f);
    while ( <F> ) {
  ####    print "$_\n";
      if (/$a/) {
  #######print "found";
        $count++;
        $file = $f;
      }
    }
    close(F);
  }
  ##print $count, "\n";
  ##print $file, "\n";
  ##print $0, "\n";

  if ($count == 0) {
    $! = 1;
    die "$0 can't find main_class\n";
  }
  if ($count != 1) {
    $! = 1;
    die "$0 found multiple ($count) mains; use $msg\n";
  }

  my $basen = $file;
  # strip off any leading path
  $basen =~ s#.*/##;
  # strip off suffix
  $basen =~ s/$suffix$//;

  return $basen;
}

my $OSdelim;
my $OSsep;

my @EMPTY = (); # global constant

sub u_init() {

  use Env qw(JR_HOME CLASSPATH OS);

  # $OS defined only (usually) on Windows
  # Cygwin: $OS is windows will work fine
  # provided that Perl was installed within Cygwin.
  if(defined($OS) && $OS =~ /Windows/) {
    $OSdelim = ";";
    $OSsep = "\\";
  }
  else {
    $OSdelim = ":";
    $OSsep = "/";
  }

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

  if (! opendir (JRHOME, $JR_HOME) ) {
    $! = 1;
    die "$0: environment variable JR_HOME set to $JR_HOME\n"
      . "   but that directory does not exist or is not readable\n";
  }
  if (! closedir(JRHOME)) {
    $! = 1;
    die "$0: cannot close $JR_HOME\n";
  }

  my $JRT_JAR;
  my $JRX_JAR;
  ## print "ct sees jrhome= $JR_HOME\n";

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

  use Getopt::Long;
  my $optionclasspath;
  # handle only -classpath here.
  # other args specific to jr, jrc, or jrrun (e.g., -version, -explicit)
  # can be handled as needed by those tools.
  Getopt::Long::Configure("pass_through");
  GetOptions('classpath=s' => \$optionclasspath)
  || die "$0: problem processing command line options\n";

  ## print "after GetOptions \n";

  my $cpath;
  if ($optionclasspath) {
    $cpath = $optionclasspath . $OSdelim;
  }
  else {
    $cpath = "";
    if(defined($CLASSPATH)) {
	$cpath = $CLASSPATH . $OSdelim;
    }
  }
  # set CLASSPATH to get JR stuff.
  # until 2003-02 we prepended "." and $JR_JAR.
  # 2004-11-27: put both in CLASSPATH since generated code imports run-time
  $CLASSPATH = $cpath . "." . $OSdelim . $JRT_JAR
                            . $OSdelim . $JRX_JAR;
  ## print "ct1 $CLASSPATH \n";
}

# note: code is nearly the same as in jrv.
# at some point, share this sub.
# (no need to name as u_ since this sub used only within u_init.pl.)
sub setjarvar {
    my $m = shift(@_); # message
    my $f = shift(@_); # jar file

    my $jar = $JR_HOME . "/classes/" . $f;
    my $archname;
    $archname = `perl -V:archname`;
    # 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";
    }

    return $jar;
}
sub u_jr(\@) {
  my $A = shift(@_);
  # for translating and running a simple JR program:
  #   usage: jr name_of_main_class [arguments to JR program]
  #
  # assumes JR program is exactly *.jr.
  #
  # note: removes jrGen (e.g., in case it was copied and now contains extra)

  #### arguably, jr should use "--"
  #### to separate jr options from program options.
  #### if it did, then below code could be replaced by call to GetOptions.
  #### similarly, jrgo and jrgox should then use "--" and could handle
  #### -explicit or -implicit args (or could hack them like below too).
  #### (jrgo and jrgox don't work now since they put the name_of_main_class
  #### as first argument to jr.)
  #### (if change anything, be sure to update book appendix.)

  # handle -explicit or -implicit
  # that appear before name_of_main_class
  # (note: doesn't handle -version anymore since test for number of args
  # below would fail.)
  # so now correctly handle, e.g.,
  #    jr -explicit main.jr (previously wasn't giving error)
  #    jr -explicit (previously wasn't giving error)
  my @args = @EMPTY;
  my $shiftcnt = 0; # bad idea to shift @A within foreach ...(@A)
  foreach my $a (@$A) {
    if ($a =~ /^-explicit$/ || $a =~ /^-implicit$/) {
	push(@args, $a);
	$shiftcnt++;
    }
    elsif ($a =~ /^-/) {
      $! = 1;
      die "unknown command line option\n";
    }
    else { # quit arg processing on first non "-" argument
      last;
    }
  }
  for (my $k=1; $k <= $shiftcnt; $k++) {
      shift(@$A);
  }

  # sanity check
  if ( @$A < 1 ) {
    $! = 1;
    die "usage: $0 name_of_main_class \[arguments to JR program\]\n";
  }

  # some error checking to avoid common mistake: jr *.jr
  if (@$A[0] =~ /\.jr$/) {
    $! = 1;
    die "error: name_of_main_class is a .jr file\n";
  }

  ##print "jr.pl $CLASSPATH \n";

  my @theargs = (@args, @$A); 

  ##print "u_jr @theargs zz \n";

  my $exitstatus;
  my $unused = # avoid "Useless use of not in void context..."
  ##!system("echo 001") &&
  !($exitstatus = u_jrt(@EMPTY)) &&
  ## !system("echo 006") &&
  !($exitstatus = u_jrrun( @theargs ));
  return $exitstatus;
}

sub u_jrc(\@) {
  my $A = shift(@_);

  ## print "u_jrc.pl $CLASSPATH \n";

  return u_mysystem("java edu.ucdavis.jr.trans.sun.tools.javac.Main -classpath \"$CLASSPATH\" @$A");

}

sub u_jrfindmain() {
  return u_findmain(".jr","`jr name_of_main_class'");
}

sub u_jrgo($) {
  my $basen = shift(@_);

  my @args = ($basen, @ARGV);

  return u_jr(@args);
}

sub u_jrrun(\@) {
  my $A = shift(@_);

  # common code set CLASSPATH, but we need it to include jrGen,
  # so we'll set it again (but only add jrGen).
  # until 2003-02 we prepended jrGen.

  $CLASSPATH= $CLASSPATH . $OSdelim . "jrGen";
  ## print "jrrun sees classpath= $CLASSPATH\n";

  my $args = u_quote_args(@$A);
  ##print "u_jrrun $args\n";
  use Env qw( JRSH JRRSH JRSHC );
  # use these variables rather than above to avoid
  # warnings about "Use of uninitialized value ..."
  my $myJRSH  = defined($JRSH ) ? $JRSH  : "";
  my $myJRRSH = defined($JRRSH) ? $JRRSH : "";
  my $myJRSHC = defined($JRSHC) ? $JRSHC : "";

  return u_mysystem ("java -DJRSH=$myJRSH -DJRSHC=$myJRSHC -DJRRSH=$myJRRSH edu.ucdavis.jr.jrx.JRX_impl $args");

}

sub u_jrt(\@) {
  my $A = shift(@_);
  if ( @$A != 0 ) {
    print STDERR "jrt ignoring command line arguments\n";
  }
  # for translating a simple JR program:
  #   usage: jrt
  #
  # assumes JR program is exactly *.jr.
  #
  # note: removes jrGen (e.g., in case it was copied and now contains extra)

  ##print "jr.pl $CLASSPATH \n";

  # 2005-02-23 following is no longer needed (and probably wasn't for a while).
  # it would also set path to a path with Windows-style separator when run
  # under Cygwin with a Cygwin Perl,
  # which caused, e.g., system("rmic ...") not to find rmic.
  ## set PATH to get JR stuff
  ##use Env qw(PATH);
  ## 2003-09-03 need $OSdelim for ActivePerl (seems OK on other Perls)
  ##$PATH = "$JR_HOME" . "$OSsep" . "bin" . "$OSdelim" . "$PATH";

  # remove
  use File::Path;
  rmtree("jrGen", 0, 1);

  # now translate
  # (note system() returns exit status, so need to negate it)
  # note: use 'javac jrGen/*.java'
  #       rather than 'cd jrGen; javac *.java'
  # in case CLASSPATH set to something interesting
  # (e.g., pathname relative to current directory)

  my @starjr = glob("*.jr");
  # print "zz @starjr \n";

  # the duplicate $OSsep in u_mysystem below is:
  #   innocuous under Windows \\ and UNIX // interpreted without harm.
  #   needed under Cygwin  \\ interpreted as \, given to javac, which
  #      interprets it as Windows pathname, bravo.
  #      (could special case for Cygwin instead,
  #       but above likely more efficient.)

  my $exitstatus;
  my $unused = # avoid "Useless use of not in void context..."
  ##!system("echo 001") &&
  !($exitstatus = u_jrc(@starjr)) &&
  ##!system("echo 002") &&
  !($exitstatus = u_mysystem("javac jrGen" . $OSsep . $OSsep . "*.java"));

  ##  Java1.5 no longer needs rmic, so we don't need the rest of this:
  ##!system("echo 003") &&
  ##chdir("jrGen") &&
  ##!system("echo 004") &&
  ##
  ##!($exitstatus = u_mysystem("$jr_rmic")) &&
  ##!system("echo 005") &&
  ##chdir("..");

  return $exitstatus;
}

sub u_mysystem($) {
  my $s = shift(@_);
  system($s);
  return $?>>8;
}

# preserve any quoting on command line by putting each A in quotes.
sub u_quote_args(\@) {
  my $A = shift(@_);
  my $args = "";
  foreach my $a ( @$A ) {
    $args .= "\"$a\" ";
    # print ":$a \n"
  }
  return $args;
}

