sub foo {
print STDERR "Entering sub foo(@_)\n";
# Do something
print STDERR "Exiting sub foo: return value $bar\n";
return $bar;
}
####
#!/usr/bin/perl -w
# usage: $0 filename [optional output file]
# If the output file is not specified, it will print to STDOUT
use strict;
my $outp;
open FILE, $ARGV[0] or die "A grim and horrible death: $!";
if ( defined( $ARGV[1] ) ) {
open OUTP, ">$ARGV[1]" or die "Couldn't write: $!";
$outp = \*OUTP;
}
else {
$outp = \*STDOUT;
}
my ( %calls, $name, @context );
#---
# First parsing phase is to try to gather all the return codes together,
# keyed by the function name
#---
while ( ) {
next if /^\s*#/;
next if /^\s*$/;
last if /__END__/;
$name = $1 if /^sub (\w+)/;
#---
# Push the context and get next line if possible
#---
if ( /^\s*return (\$?[\w->:]+) (if .+)[;{]$/ ||
/^\s*return (\$?[\w->:]+) (unless .+)[;{]$/ ) {
my ( $code, $context ) = ( $1, $2 );
chomp $context;
$context =~ s/^\s+//;
push @{$calls{$name}{$code}}, $context;
next;
}
if ( /(.+){$/ ) {
chomp;
s/^\s+//;
push @context, $_
}
pop @context if ( /}$/ );
push(@{$calls{$name}{$1}}, $context[-1]),next if ( /\s*return (\$?[\w->:{}]+
)/ );
}
close FILE;
for my $name ( sort keys %calls ) {
for my $rc ( sort keys %{$calls{$name}} ) {
print $outp "$rc when:\n\t";
local $" = "\n\t";
print $outp "@{$calls{$name}{$rc}}\n";
}
}
####
#!/usr/bin/perl -w
use strict;
die "$0