#!/usr/bin/perl # This is the frontend for the modules PIL::Parser and PIL::Nodes. # See sub &usage at the bottom for usage information. use warnings; use strict; use lib "lib"; # Minor hack INIT { if($ENV{PIL2JS_RESOURCE_GUARD}) { require BSD::Resource; import BSD::Resource; setrlimit(RLIMIT_CPU(), 43, 47) or die "Couldn't setrlimit: $!\n"; warn "*** Limited CPU resources.\n"; } } use FindBin; use File::Spec; use lib File::Spec->catdir($FindBin::Bin, "lib"); use lib File::Spec->catdir($FindBin::Bin); use PIL2JS qw< run_pugs >; use Getopt::Long; use PIL::Parser; use PIL; use Encode; sub slurp; sub unslurp; sub usage; my $verbose; my $link; my $output = "-"; my $yaml_dump; GetOptions( "verbose" => \$verbose, "link=s" => \$link, "output=s" => \$output, "yaml-dump" => \$yaml_dump, "pugs=s" => \$PIL2JS::cfg{pugs}, "metamodel-base=s" => \$PIL2JS::cfg{metamodel_base}, "help" => sub { usage() }, ) or usage(); my @input = @ARGV; usage "No input files given!" unless @input; usage "Cannot compile multiple files at once!" if not $link and @input > 1; usage "--yaml-dump doesn't work with --link!" if $yaml_dump and $link; usage "Invalid argument for --link!" if $link and not($link eq "js" or $link eq "html"); unless($link) { warn "*** Reading input from \"$input[0]\"...\n" if $verbose; my $pil = $input[0] =~ /\.(?:pl|p6|pm|p6m|t)$/i ? decode "utf-8", run_pugs("-CPIL1-Perl5", $input[0]) : slurp $input[0]; my $tree = PIL::Parser->parse($pil); if($yaml_dump) { require YAML; print encode "utf-8", YAML::Dump($tree); exit; } warn "*** Compiling PIL to JavaScript...\n" if $verbose; my $load_check = < "PIL")->as_js; unslurp $output, $js; } else { my @components; # unshift @input, ($link eq "html" ? "~" : "") . guess_jsprelude_path(); @input = map { /^(~?)METAMODEL$/ ? map { $1 . $PIL2JS::cfg{metamodel_base} . join("/", split /\./, $_) . ".js" } qw< Perl6.MetaModel Perl6.Attribute Perl6.Method Perl6.MultiMethod Perl6.MetaClass.Dispatcher Perl6.MetaClass Perl6.Class Perl6.Instance Perl6.Object > : ($_) } @input; my $js; foreach my $file (@input) { my $mode = $file =~ s/^~// ? "link" : "inline"; if($mode eq "inline") { warn "*** Reading JavaScript from \"$file\"...\n" if $verbose; push @components, [inline => "// File: $file\n" . slurp($file) . "\n"]; } else { push @components, [link => $file]; } } push @components, [inline => <" }; my $html = < PIL2JS 


EOF

    foreach (@components) {
      my ($mode, $contents) = @$_;
      if($mode eq "link") {
        $html .= "    " . $link->($contents) . "\n";
      } else {
        die "JavaScript contains HTML escape sequenze ']]>', aborting.\n"
          if $contents =~ /\]\]>/;
        $html .= <//($contents)]}
      //]]>
    
EOF
      }
    }

    $html .= <

EOF
    unslurp $output, $html;
  }
}

sub usage {
  if($_[0]) {
    die "*** $_[0]\n    Try \"$0 --help\" for usage information.\n";
  } else {
    print STDERR <". Of course, this feature is not available
when linking to a standalone JavaScript file.

Recommended usage:
  \$ cd perl5/PIL2JS
  \$ ./pil2js.pl -o Prelude.js lib6/Prelude/JS.pm
  \$ ./pil2js.pl -o test.js test.pl
  \$ ./pil2js.pl -o test.js test.pil
  \$ ./pil2js.pl --link=js   -o full.js    METAMODEL  libjs/PIL2JS.js  Prelude.js test.js
  \$ ./pil2js.pl --link=html -o test.html ~METAMODEL ~libjs/PIL2JS.js ~Prelude.js test.js
USAGE

sub slurp {
  open my $fh, "< $_[0]" or die "Couldn't open \"$_[0]\" for reading: $!\n";
  local $/;
  return decode "utf-8", <$fh>;
}

sub unslurp {
  open my $fh, "> $_[0]"          or die "Couldn't open \"$_[0]\" for writing: $!\n";
  print $fh encode "utf-8", $_[1] or die "Couldn't write to \"$_[0]\": $!\n";
  close $fh                       or die "Couldn't close \"$_[0]\": $!\n";
}