#!/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 = <<EOF;
try { PIL2JS.Box } catch(err) {
var error = new Error("PIL2JS.js not loaded; aborting.");
alert(error);
throw(error);
}
EOF
my $js = join "\n",
$load_check,
(bless $tree => "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 => <<EOF];
// Trigger running of all END blocks.
PIL2JS.catch_all_exceptions(function () {
PIL2JS.catch_end_exception(function() {
PIL2JS.runloop(function () {
_26main_3a_3aexit.FETCH()([
PIL2JS.Context.ItemAny,
new PIL2JS.Box.Constant(undefined),
function () { 'dummycc' }
]);
});
});
});
EOF
if($link eq "js") {
my $js;
foreach (@components) {
my ($mode, $contents) = @$_;
die "*** Can't link to files when creating a standalone JavaScript file!\n"
if $mode eq "link";
$js .= $contents;
}
unslurp $output, $js;
} else {
my $indent = sub { join "\n", map { " " x 6 . $_ } split "\n", shift };
my $link = sub { "<script type=\"text/javascript\" src=\"$_[0]\"></script>" };
my $html = <<EOF;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>PIL2JS</title>
</head>
<body>
<pre id="__pil2js_tty"></pre>
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 .= <<EOF;
<script type="text/javascript">//<![CDATA[
@{[$indent->($contents)]}
//]]>
</script>
EOF
}
}
$html .= <<EOF;
</body>
</html>
EOF
unslurp $output, $html;
}
}
sub usage {
if($_[0]) {
die "*** $_[0]\n Try \"$0 --help\" for usage information.\n";
} else {
print STDERR <<USAGE; exit }}
pil2js.pl compiles PIL as generated by Pugs to JavaScript.
Usage: pil2js.pl [options] -- input_files
Available options (options may be abbreviated to uniqueness):
--verbose Be verbose.
--pugs=/path/to/pugs
--metamodel-base=/path/to/Perl6.MetaModel/lib/
--output=... Output to the given filename.
Use "-" if you want the result to go to STDOUT.
--link=html|js Link precompiled files into one standalone JavaScript
file ("js") or into a HTML file ("html").
--yaml-dump Only output the input PIL as YAML; don't compile anything.
When compiling (--link option not given), there has to be only one input file.
In linking mode, multiple input files may be specified. If a filename is
prefixed with a tilde ("~"), the file is not inlined, but instead linked to
using the HTML tag "<script src=...>". 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";
}