#!/usr/bin/perl -w

#### reminder: this file (which resides in $RJ_HOME/bin or $RJ_HOME\bin)
#### is generated from files in $RJ_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_rj(\@);
sub u_rjc(\@);
sub u_rjfindmain();
sub u_rjgo($);
sub u_rjgot(\@);
sub u_rjgox($);
sub u_rjrun(\@);
sub u_rjt(\@);
sub u_mysystem($);
sub u_quote_args(\@);

u_init();
my $exitstatus;
$exitstatus = u_rj(@ARGV);
exit $exitstatus;

my $OSdelim;
my $OSsep;

my @EMPTY = (); # global constant

sub u_init() {

  use Env qw(RJ_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 (! $RJ_HOME ) {
    $! = 1;
    die "$0 requires environment variable RJ_HOME\n"
      . "   to be set to the absolute pathname of RJ's home\n";
  }

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

  my $RJT_JAR;
######  my $JRX_JAR;
  ## print "ct sees rjhome= $RJ_HOME\n";

  ##Set the RJT_JAR and JRX_JAR variables
##  print "u_init: **** using hardwired RJ and JRX ********\n";
#  $RJT_JAR = setjarvar( "RJT", $RJ_HOME . "rj.jar");
#  $JRX_JAR = setjarvar( "JRX", "jrx.jar");
## for now ........
### setjarvar needs work ...
  $RJT_JAR = $RJ_HOME . "/source/rj.jar";
##########  $JRX_JAR = "/home/olsson/PKG/rjimpl/2.00603/source/jrx.jar";

  use Getopt::Long;
  my $optionclasspath;
  # handle only -classpath here.
  # other args specific to rj, rjc, or rjrun (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 RJ stuff.
##  $CLASSPATH = $cpath . "." . $OSdelim . $RJT_JAR
##                            . $OSdelim . $JRX_JAR;

##################################################################
# don't want CLASSPATH with JR in it.....
# hmmm.  that could be a problem here for user who uses JR and RJ
# think about that later........
  $CLASSPATH =          "." . $OSdelim . $RJT_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 = $RJ_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/) {
	# 2007-10-20 quotes needed on $jar since it might contain spaces.
        $jar  = `cygpath -w "$jar"`;
	chomp($jar);
    }

    # Make sure that the file $jar points to is accessible
    # 2006-08-13 was:
    # if ( (-e $jar) !=1 || (-r $RJ_HOME) != 1 ) {
    # but discovered that -e returns undefined if file doesn't exist
    # and then can't compare undefined with number.
    # (seems like it should return false.  Oh well, below is better anyway.)
    if ( !(-e $jar) || !(-r $RJ_HOME) ) {
	$! = 1;
	die "$0: $m jar file set to " .
	    $jar .
	    "\nbut that file does not exist or is not readable\n";
    }

    return $jar;
}
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;
}

sub u_rj(\@) {
  my $A = shift(@_);
  # for translating and running a simple RJ program:
  #   usage: rj name_of_main_class [arguments to RJ program]
  #
  # assumes RJ program is exactly *.java.
  #
  # note: first removes *.class to be safe

  # 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.,
  #    rj -explicit main.java (previously wasn't giving error)
  #    rj -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 RJ program\]\n";
  }

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

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

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

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

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

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

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

  return u_mysystem("javac -classpath \"$CLASSPATH\" @$A");

}

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

  ##print "rjrun sees classpath= $CLASSPATH\n";

##  print "rjrun for now using JR shell variables JRSH, etc. and JRX_impl\n";

  my $args = u_quote_args(@$A);
  ## print "u_rjrun $args\n";
  use Env qw( RJSH RJRSH RJSHC );
  # use these variables rather than above to avoid
  # warnings about "Use of uninitialized value ..."
  my $myRJSH  = defined($RJSH ) ? $RJSH  : "";
  my $myRJRSH = defined($RJRSH) ? $RJRSH : "";
  my $myRJSHC = defined($RJSHC) ? $RJSHC : "";

  ## print ("java -DRJSH=$myRJSH -DRJSHC=$myRJSHC -DRJRSH=$myRJRSH edu.ucdavis.rj.VM.RJX_impl $args \n");

  return u_mysystem ("java -DRJSH=$myRJSH -DRJSHC=$myRJSHC -DRJRSH=$myRJRSH edu.ucdavis.rj.RJX_impl $args");

}

sub u_rjt(\@) {
  my $A = shift(@_);
  if ( @$A != 0 ) {
    print STDERR "rjt ignoring command line arguments\n";
  }
  # for translating a simple RJ program:
  #   usage: rjt
  #
  # assumes RJ program is exactly *.java.
  #
  # note: first removes *.java
  # in case extra junk there (e.g., delete A.java, but A.class still there).

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

  # remove
  unlink glob "*.class";

  my @starjava = glob("*.java");
  # print "zz @starjava \n";

  # now translate
  # (note system() returns exit status, so need to negate it)

  my $exitstatus;
  my $unused = # avoid "Useless use of not in void context..."
  ##!system("echo 001") &&
      !($exitstatus = u_rjc(@starjava));

  return $exitstatus;
}

