Test

#!/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 () { 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_"; Test \ \
_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{\n}{
}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{$content}; } $out .= escape substr($str, $to); #warn $out; return "$out"; } __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 =item * "A graphical tracer for Perl 6 regexes based on PCR" L. =back =head1 AUTHOR Agent Zhang Eagentzh@yahoo.cnE. =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.