1package Pugs::Runtime::Tracer; 2 3use strict; 4use warnings; 5use base 'Exporter'; 6#use Smart::Comments; 7 8our @EXPORT = qw( 9 trace_begin trace_end trace 10 expand_tracing_code 11); 12 13sub trace_begin ($$$$) { 14 my ($name, $from, $to, $pos) = @_; 15 trace(">>BEGIN $name<< $from..$to at $pos\n"); 16} 17 18sub trace_end ($$$) { 19 my ($name, $res, $pos) = @_; 20 trace(">>END $name<< ", $res ? 'success' : 'fail', " at $pos\n"); 21} 22 23sub trace ($@) { 24 if (!defined $::PCR_TRACE_FH) { 25 $::PCR_TRACE_FH = \*STDOUT; 26 } 27 print $::PCR_TRACE_FH @_; 28} 29 30sub expand_tracing_code { 31 my $s = shift; 32 open my $in, '<', \$s or die; 33 my (@names, $name, $new, @has_pos); 34 while (<$in>) { 35 chomp; 36 if (/\s+## <(\w+)>$/) { 37 $name = $1; 38 push @names, $name; 39 push @has_pos, 0; 40 ### begin: $name 41 $new .= $_ . "\n"; 42 } elsif (/(\s+)## pos: (\d+) (\d+)$/) { 43 my ($tab, $from, $to) = ($1, $2, $3); 44 $has_pos[-1] = 1; 45 $new .= <<"_EOC_"; 46$_ 47$tab do { 48$tab Pugs::Runtime::Tracer::trace_begin('$name', $from, $to, \$pos); 49$tab my \$retval = 50_EOC_ 51 } elsif (/(\s+)## <\/(\w+)>$/) { 52 my ($tab, $n) = ($1, $2); 53 $name = pop @names; 54 my $has_pos = pop @has_pos; 55 ### end: $n . "<=>" . $name 56 if (!defined $name || $n ne $name) { 57 die "ERROR: unexpected closing tag </$n>"; 58 } elsif ($has_pos) { 59 $new .= <<"_EOC_"; 60$_ 61$tab ; 62$tab Pugs::Runtime::Tracer::trace_end('$name', \$retval, \$pos); 63$tab \$retval; 64$tab } 65_EOC_ 66 } 67 if (!$has_pos) { 68 #warn "No pos info found for <$n>"; 69 } 70 } else { 71 $new .= $_ . "\n"; 72 } 73 } 74 return $new; 75} 76 771; 78__END__ 79 80=head1 NAME 81 82Pugs::Runtime::Tracer - tracer runtime for Pugs::Compiler::Rule 83 84=head1 SYNOPSIS 85 86 use Pugs::Runtime::Tracer; 87 trace("blah blah blah"); 88 trace_begin($regex_name, $regex_pos_from, $regex_pos_to, $input_pos); 89 trace_end($regex_name, $success, $input_pos); 90 $perl5_code_with_tracing_code = expand_tracing_code($perl5_code); 91 92=head1 DESCRIPTION 93 94This module provides tracing facilities for both PCR compile-time and run-time. 95 96=head1 SEE ALSO 97 98=over 99 100=item * 101 102L<compile_p6grammar.pl> 103 104=item * 105 106"A graphical tracer for Perl 6 regexes based on PCR" 107 108L<http://pugs.blogs.com/pugs/2007/10/a-graphical-tra.html>. 109 110=back 111 112=head1 AUTHOR 113 114Agent Zhang E<lt>agentzh@yahoo.cnE<gt>. 115 116=head1 COPYRIGHT 117 118Copyright 2007 by Yahoo! China Inc. L<http://cn.yahoo.com>. 119 120=head1 LICENSE 121 122This module is free software; you can redistribute it and/or modify it 123under the same terms as Perl itself. 124 125