| #! /usr/bin/perl |
| use strict; |
| use Getopt::Long; |
| use File::Copy; |
| |
| # options |
| my @optlist = ("h|help!","v|verbose!","S!","d=s","J=s"); |
| my $result = GetOptions @optlist; |
| our ($opt_h, $opt_v, $opt_S, $opt_d, $opt_J); |
| |
| # -h option || check the number of arguments |
| if ($opt_h || @ARGV < 1 ) { |
| usage(); |
| exit 1; |
| } |
| |
| # local variables |
| my $pl2am = "pl2am.plj"; |
| my $pl2am_opts = "-O"; |
| my $am_dest = "/tmp"; |
| my $am2j = "am2j.plj"; |
| my $am2j_opts = ""; |
| my $java_dest = "."; |
| |
| # -v option |
| if ($opt_v) { |
| $pl2am_opts .= " -v"; |
| $am2j_opts .= " -v"; |
| } |
| |
| # -d option |
| if ($opt_d) { |
| if (! -d $opt_d) { |
| &error("directory $opt_d does not exist."); |
| } else { |
| $java_dest = $opt_d; |
| } |
| } |
| |
| # -J option |
| if ($opt_J) { |
| $pl2am_opts .= " -J '$opt_J'"; |
| $am2j_opts .= " -J '$opt_J'"; |
| } |
| |
| foreach my $file (@ARGV) { |
| my $f = $file; |
| $f =~ s/.pl$//g; |
| $f = &url_encode($f); |
| my $am_file = "$am_dest/$f.am"; |
| my $cmd1 = "$pl2am $pl2am_opts $file $am_file"; |
| my $cmd2 = "$am2j $am2j_opts -d $java_dest $am_file"; |
| &message("{START translating $file --> java}"); |
| &message($cmd1); |
| system($cmd1) && error("$cmd1 fails"); |
| &message($cmd2); |
| system($cmd2) && error("$cmd2 fails"); |
| if ($opt_S) { |
| &message("copy $am_file to $java_dest"); |
| copy($am_file, $java_dest) || &error("can not copy $am_file to $java_dest"); |
| } else { |
| &message("unlink $am_file"); |
| unlink $am_file; |
| } |
| &message("{END translating $file --> java}\n"); |
| } |
| |
| exit 0; |
| |
| # sub |
| sub usage { |
| print "\nUsage: $0 [-options] prolog-file [prolog-files]\n"; |
| print "\n where options include:\n"; |
| print "\t-h -help : print this help message\n"; |
| print "\t-v -verbose : enable verbose output\n"; |
| print "\t-S : output WAM-like abstract machine codes\n"; |
| print "\t : the files suffied by \".am\" is created.\n"; |
| print "\t-d directory : set the destination directory for java files.\n"; |
| print "\t : The destination directory must already exist\n"; |
| print "\t-J option : option must be enclosed by '.\n"; |
| print "\t : pass option to the Java Virtual Machine\n"; |
| print "\t : (ex. -J '-Xmx100m -verbose:gc')\n"; |
| print "\n"; |
| } |
| |
| sub message { |
| my ($x) = @_; |
| if ($opt_v) { # check -v option |
| print "\% $x\n"; |
| } |
| } |
| |
| sub error { |
| my ($x) = @_; |
| print "\% ERROR: $x: $0\n"; |
| exit(1); |
| } |
| |
| sub url_encode{ |
| my $x = shift; |
| $x =~ s/([^0-9A-Za-z_ ])/'%'.unpack('H2',$1)/ge; |
| $x =~ s/\s/+/g; |
| return $x; |
| } |