| Description: |
This little program, when run on another Perl program, prints a listing to standard output that has comments that show the return value of executable lines. For instance, it produced the comments you see here:my $a = 'I am a test'; ##=> scalar: "I am a test"
$c = "I am a test\n"; ##=> scalar: "I am a test\n"
my $b = length($a); ##=> scalar: 11
my %c = (
a => 1,
c => { d => 3 }
); ##=> array: ["a",1,"c",{"d" => 3}]
sub xx { return wantarray ? (1, 4) : 3; }
my @a = xx(); ##=> array: [1,4]
my $b = xx(); ##=> scalar: 3
xx(); ##=> scalar: 3 array: [1,4]
|
# Utility to run given Perl program line by line and print out
# values as comments (for annotation)
# Strictly brute-force. Watch out for side-effects!
#
# Vim users can use this like:
# vmap <F9> !perl annotate.pl<CR>
# nmap <F9> :.!perl annotate.pl<CR>
use strict;
package Annotate; # keep my own namespace so as not to pollute main
use Data::Dumper();
$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;
$Data::Dumper::Useqq = 1;
# these are locals so they're not visible in the evals.
use vars qw(@program @sresults @aresults $programText $i $sresult @are
+sult);
while (<>)
{
s/[\n\r\s]+$//;
s/\s*##=> (?:array|scalar).*//;
push ( @program, $_ );
}
# set up Perl defaults:
$programText = "no strict; package main;";
for $i ( 0 .. $#program )
{
$programText .= $program[$i] . "\n";
$sresult = eval $programText;
next if $@;
@aresult = eval $programText;
if ( @aresult == 1 && $aresult[0] == $sresult )
{
$sresults[$i] = $sresult;
}
elsif ( scalar(@aresult) == $sresult )
{
$aresults[$i] = [@aresult];
}
else # different scalar and array results
{
$sresults[$i] = $sresult;
$aresults[$i] = [@aresult];
}
}
die "error: $@" if $@;
sub result { Data::Dumper->Dump( [shift] ) }
for $i ( 0 .. $#program )
{
print $program[$i];
if ( $program[$i] =~ /^[^#]*;(\s*#.*)?$/
&& ( defined( $sresults[$i] ) || defined( $aresults[$i] ) ) )
{
print "\t##=>";
print " scalar: ", result( $sresults[$i] ) if defined( $sresul
+ts[$i] );
print " array: ", result( $aresults[$i] ) if defined( $aresul
+ts[$i] );
}
print "\n";
}
|