blob: 09358f98a61ee44c91607e5cf7c48987e13040a2 [file] [log] [blame]
#! /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;
}