#!/usr/bin/env perl
use strict;
use warnings;
use JSON::Syck;
use File::Slurp;
use Getopt::Long;
use File::Spec ();
use File::Path 'mkpath';
use File::Copy 'copy';
#use Smart::Comments;
use List::MoreUtils qw( uniq );
my $outdir = '.';
GetOptions(
'outdir=s' => \$outdir
) or die help();
if (!-d $outdir) { mkpath $outdir; }
sub help {
die "Usage: $0 [--outdir=.] grammar_file input_file < trace.out\n";
}
my $gmr_file = shift or die "No grammar file given";
my $str_file = shift or die "No str file given";
my (@regex_pos, @str_pos);
my @ops;
while (<STDIN>) {
if (/^>>BEGIN (\w+)<< (\d+)\.\.(\d+) at (\d+)/) {
my ($symbol, $from, $to, $pos) = ($1, $2, $3, $4);
## $symbol
## $from
## $to
## $pos
push @regex_pos, $from, $to;
push @str_pos, $pos;
push @ops, ['begin', $symbol, $from, $to, $pos];
} elsif (/^>>END (\w+)<< (\w+) at (\d+)/) {
my ($symbol, $res, $pos) = ($1, $2, $3);
## $symbol
## $res
## $pos
push @str_pos, $pos;
push @ops, ['end', $symbol, $res, $pos];
}
}
@regex_pos = uniq sort { $a <=> $b } @regex_pos;
@str_pos = uniq sort { $a <=> $b } @str_pos;
### @regex_pos
### @str_pos
my $gmr = read_file($gmr_file);
my $id = "R" . $regex_pos[0] . "-" . $regex_pos[1];
#warn $id;
my $js_ops = JSON::Syck::Dump(\@ops);
my $js_regex_pos = JSON::Syck::Dump(\@regex_pos);
my $js_str_pos = JSON::Syck::Dump(\@str_pos);
#warn scalar(@ops);
#warn $js_ops;
my $html = to_html($gmr, \@regex_pos);
my $outfile = File::Spec->catfile($outdir, 'gmr.html');
print "Write $outfile\n";
write_file($outfile, $html);
my $str = read_file($str_file);
$html = to_html($str, \@str_pos);
$outfile = File::Spec->catfile($outdir, 'str.html');
print "Write $outfile\n";
write_file($outfile, $html);
my $tracer_js = read_file('tracer/tracer.js');
$html = <<"_EOC_";
<html>
<head>
<title>Test</title>
<script src="tracer/jquery.js"></script>
<script type="application/javascript">
var Ops = $js_ops;
var Id = '$id';
var regexPos = $js_regex_pos;
var strPos = $js_str_pos;
$tracer_js
</script>
</head>
<body>
\
<button id="reset">Reset</button>
<button id="next">Next</button>
\ <span id="label"></span><br />
<iframe id="gmr" src="gmr.html" width="49.7%" height="95%" style="margin-top: 0.5em"></iframe>
<iframe id="str" src="str.html" width="49.7%" height="95%" style="margin-top: 0.5em"></iframe>
</body>
</html>
_EOC_
$outfile = File::Spec->catfile($outdir, 'index.html');
print "Write $outfile\n";
write_file($outfile, $html);
#my $tracer_js = File::Spec->catfile($outdir, 'tracer/tracer.js');
my $jquery_js = File::Spec->catfile($outdir, 'tracer/jquery.js');
if ($outdir ne '.') {
if (!-d "$outdir/tracer") {
mkpath("$outdir/tracer");
}
print "Write $jquery_js\n";
copy('tracer/jquery.js', $jquery_js);
#print "Write $tracer_js\n";
#copy('tracer/tracer.js', $tracer_js);
}
sub escape ($) {
my $s = shift;
$s =~ s/\&/\&/g;
$s =~ s/</\</g;
$s =~ s/>/\>/g;
$s =~ s/ /\ /g;
$s =~ s{\n}{<br />}g;
$s;
}
sub to_html {
my ($str, $list) = @_;
my @pos = @$list;
return unless @pos;
my $to = $pos[0];
my $from = 0;
my $out = escape substr($str, $from, $to - $from);
for my $i (1..$#pos) {
$from = $to;
$to = $pos[$i];
#warn "$from <=> $to";
my $id = "R" . $from . "-" . $to;
#warn $id;
my $content = escape substr($str, $from, $to - $from);
$out .= qq{<span id="$id">$content</span>};
}
$out .= escape substr($str, $to);
#warn $out;
return "<code>$out</code>";
}
__END__
=head1 NAME
gen-tracer-view.pl - Generate the HTML view for the PCR tracer
=head1 SYNOPSIS
$ perl util/compile_p6grammar.pl -D examples/digits.grammar > Digits.pm
$ echo '7c3d54' > digits.input
$ perl -Ilib -MDigits -e 'print Digits->count(<>)->(), "\n"' digits.input > trace.out
$ perl util/gen-tracer-view.pl --outdir tmp/digits examples/digits.grammar digits.input < trace.out
$ firefox tmp/digits/index.html
=head1 SEE ALSO
=over
=item *
L<compile_p6grammar.pl>
=item *
"A graphical tracer for Perl 6 regexes based on PCR"
L<http://pugs.blogs.com/pugs/2007/10/a-graphical-tra.html>.
=back
=head1 AUTHOR
Agent Zhang E<lt>agentzh@yahoo.cnE<gt>.
=head1 COPYRIGHT
Copyright (c) 2007 by Yahoo! China Inc.
=head1 LICENSE
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.