X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB%2FShowlex.pm;h=3b261a337df835e07b744d51ff534c12c37755eb;hb=bb7c595be2e30a806b95ad83e9d3613aeb95c384;hp=9cf8ecc564338b94b4dc381156efadd34c02de9e;hpb=a798dbf2f5009fe67f7460a594ffd57a76c0fa98;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B/Showlex.pm b/ext/B/B/Showlex.pm index 9cf8ecc..3b261a3 100644 --- a/ext/B/B/Showlex.pm +++ b/ext/B/B/Showlex.pm @@ -1,7 +1,11 @@ package B::Showlex; + +our $VERSION = '1.02'; + use strict; use B qw(svref_2object comppadlist class); use B::Terse (); +use B::Concise (); # # Invoke as @@ -10,49 +14,192 @@ use B::Terse (); # or as # perl -MO=Showlex bar.pl # to see the names of file scope lexicals used by bar.pl -# +# + + +# borrowed from B::Concise +our $walkHandle = \*STDOUT; + +sub walk_output { # updates $walkHandle + $walkHandle = B::Concise::walk_output(@_); + #print "got $walkHandle"; + #print $walkHandle "using it"; + $walkHandle; +} + +sub shownamearray { + my ($name, $av) = @_; + my @els = $av->ARRAY; + my $count = @els; + my $i; + print $walkHandle "$name has $count entries\n"; + for ($i = 0; $i < $count; $i++) { + my $sv = $els[$i]; + if (class($sv) ne "SPECIAL") { + printf $walkHandle "$i: %s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX; + } else { + printf $walkHandle "$i: %s\n", $sv->terse; + #printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv); + } + } +} -sub showarray { +sub showvaluearray { my ($name, $av) = @_; my @els = $av->ARRAY; my $count = @els; my $i; - print "$name has $count entries\n"; + print $walkHandle "$name has $count entries\n"; for ($i = 0; $i < $count; $i++) { - print "$i: "; - $els[$i]->terse; + printf $walkHandle "$i: %s\n", $els[$i]->terse; + #print $walkHandle "$i: %s\n", B::Concise::concise_sv($els[$i]); } } sub showlex { my ($objname, $namesav, $valsav) = @_; - showarray("Pad of lexical names for $objname", $namesav); - showarray("Pad of lexical values for $objname", $valsav); + shownamearray("Pad of lexical names for $objname", $namesav); + showvaluearray("Pad of lexical values for $objname", $valsav); +} + +my ($newlex, $nosp1); # rendering state vars + +sub newlex { # drop-in for showlex + my ($objname, $names, $vals) = @_; + my @names = $names->ARRAY; + my @vals = $vals->ARRAY; + my $count = @names; + print $walkHandle "$objname Pad has $count entries\n"; + printf $walkHandle "0: %s\n", $names[0]->terse unless $nosp1; + for (my $i = 1; $i < $count; $i++) { + printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse + unless $nosp1 and $names[$i]->terse =~ /SPECIAL/; + } } sub showlex_obj { my ($objname, $obj) = @_; $objname =~ s/^&main::/&/; - showlex($objname, svref_2object($obj)->PADLIST->ARRAY); + showlex($objname, svref_2object($obj)->PADLIST->ARRAY) if !$newlex; + newlex ($objname, svref_2object($obj)->PADLIST->ARRAY) if $newlex; } sub showlex_main { - showlex("comppadlist", comppadlist->ARRAY); + showlex("comppadlist", comppadlist->ARRAY) if !$newlex; + newlex ("main", comppadlist->ARRAY) if $newlex; } sub compile { - my @options = @_; - if (@options) { - return sub { - my $objname; - foreach $objname (@options) { + my @options = grep(/^-/, @_); + my @args = grep(!/^-/, @_); + for my $o (@options) { + $newlex = 1 if $o eq "-newlex"; + $nosp1 = 1 if $o eq "-nosp"; + } + + return \&showlex_main unless @args; + return sub { + my $objref; + foreach my $objname (@args) { + next unless $objname; # skip nulls w/o carping + + if (ref $objname) { + print $walkHandle "B::Showlex::compile($objname)\n"; + $objref = $objname; + } else { $objname = "main::$objname" unless $objname =~ /::/; - eval "showlex_obj('&$objname', \\&$objname)"; + print $walkHandle "$objname:\n"; + no strict 'refs'; + die "err: unknown function ($objname)\n" + unless *{$objname}{CODE}; + $objref = \&$objname; } + showlex_obj($objname, $objref); } - } else { - return \&showlex_main; } } 1; + +__END__ + +=head1 NAME + +B::Showlex - Show lexical variables used in functions or files + +=head1 SYNOPSIS + + perl -MO=Showlex[,-OPTIONS][,SUBROUTINE] foo.pl + +=head1 DESCRIPTION + +When a comma-separated list of subroutine names is given as options, Showlex +prints the lexical variables used in those subroutines. Otherwise, it prints +the file-scope lexicals in the file. + +=head1 EXAMPLES + +Traditional form: + + $ perl -MO=Showlex -e 'my ($i,$j,$k)=(1,"foo")' + Pad of lexical names for comppadlist has 4 entries + 0: SPECIAL #1 &PL_sv_undef + 1: PVNV (0x9db0fb0) $i + 2: PVNV (0x9db0f38) $j + 3: PVNV (0x9db0f50) $k + Pad of lexical values for comppadlist has 5 entries + 0: SPECIAL #1 &PL_sv_undef + 1: NULL (0x9da4234) + 2: NULL (0x9db0f2c) + 3: NULL (0x9db0f44) + 4: NULL (0x9da4264) + -e syntax OK + +New-style form: + + $ perl -MO=Showlex,-newlex -e 'my ($i,$j,$k)=(1,"foo")' + main Pad has 4 entries + 0: SPECIAL #1 &PL_sv_undef + 1: PVNV (0xa0c4fb8) "$i" = NULL (0xa0b8234) + 2: PVNV (0xa0c4f40) "$j" = NULL (0xa0c4f34) + 3: PVNV (0xa0c4f58) "$k" = NULL (0xa0c4f4c) + -e syntax OK + +New form, no specials, outside O framework: + + $ perl -MB::Showlex -e \ + 'my ($i,$j,$k)=(1,"foo"); B::Showlex::compile(-newlex,-nosp)->()' + main Pad has 4 entries + 1: PVNV (0x998ffb0) "$i" = IV (0x9983234) 1 + 2: PVNV (0x998ff68) "$j" = PV (0x998ff5c) "foo" + 3: PVNV (0x998ff80) "$k" = NULL (0x998ff74) + +Note that this example shows the values of the lexicals, whereas the other +examples did not (as they're compile-time only). + +=head2 OPTIONS + +The C<-newlex> option produces a more readable C<< name => value >> format, +and is shown in the second example above. + +The C<-nosp> option eliminates reporting of SPECIALs, such as C<0: SPECIAL +#1 &PL_sv_undef> above. Reporting of SPECIALs can sometimes overwhelm +your declared lexicals. + +=head1 SEE ALSO + +C can also be used outside of the O framework, as in the third +example. See C for a fuller explanation of reasons. + +=head1 TODO + +Some of the reported info, such as hex addresses, is not particularly +valuable. Other information would be more useful for the typical +programmer, such as line-numbers, pad-slot reuses, etc.. Given this, +-newlex isnt a particularly good flag-name. + +=head1 AUTHOR + +Malcolm Beattie, C + +=cut