| 1 | package B::Showlex; |
| 2 | |
| 3 | our $VERSION = '1.00'; |
| 4 | |
| 5 | use strict; |
| 6 | use B qw(svref_2object comppadlist class); |
| 7 | use B::Terse (); |
| 8 | |
| 9 | # |
| 10 | # Invoke as |
| 11 | # perl -MO=Showlex,foo bar.pl |
| 12 | # to see the names of lexical variables used by &foo |
| 13 | # or as |
| 14 | # perl -MO=Showlex bar.pl |
| 15 | # to see the names of file scope lexicals used by bar.pl |
| 16 | # |
| 17 | |
| 18 | sub shownamearray { |
| 19 | my ($name, $av) = @_; |
| 20 | my @els = $av->ARRAY; |
| 21 | my $count = @els; |
| 22 | my $i; |
| 23 | print "$name has $count entries\n"; |
| 24 | for ($i = 0; $i < $count; $i++) { |
| 25 | print "$i: "; |
| 26 | my $sv = $els[$i]; |
| 27 | if (class($sv) ne "SPECIAL") { |
| 28 | printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX; |
| 29 | } else { |
| 30 | $sv->terse; |
| 31 | } |
| 32 | } |
| 33 | } |
| 34 | |
| 35 | sub showvaluearray { |
| 36 | my ($name, $av) = @_; |
| 37 | my @els = $av->ARRAY; |
| 38 | my $count = @els; |
| 39 | my $i; |
| 40 | print "$name has $count entries\n"; |
| 41 | for ($i = 0; $i < $count; $i++) { |
| 42 | print "$i: "; |
| 43 | $els[$i]->terse; |
| 44 | } |
| 45 | } |
| 46 | |
| 47 | sub showlex { |
| 48 | my ($objname, $namesav, $valsav) = @_; |
| 49 | shownamearray("Pad of lexical names for $objname", $namesav); |
| 50 | showvaluearray("Pad of lexical values for $objname", $valsav); |
| 51 | } |
| 52 | |
| 53 | sub showlex_obj { |
| 54 | my ($objname, $obj) = @_; |
| 55 | $objname =~ s/^&main::/&/; |
| 56 | showlex($objname, svref_2object($obj)->PADLIST->ARRAY); |
| 57 | } |
| 58 | |
| 59 | sub showlex_main { |
| 60 | showlex("comppadlist", comppadlist->ARRAY); |
| 61 | } |
| 62 | |
| 63 | sub compile { |
| 64 | my @options = @_; |
| 65 | if (@options) { |
| 66 | return sub { |
| 67 | my $objname; |
| 68 | foreach $objname (@options) { |
| 69 | $objname = "main::$objname" unless $objname =~ /::/; |
| 70 | eval "showlex_obj('&$objname', \\&$objname)"; |
| 71 | } |
| 72 | } |
| 73 | } else { |
| 74 | return \&showlex_main; |
| 75 | } |
| 76 | } |
| 77 | |
| 78 | 1; |
| 79 | |
| 80 | __END__ |
| 81 | |
| 82 | =head1 NAME |
| 83 | |
| 84 | B::Showlex - Show lexical variables used in functions or files |
| 85 | |
| 86 | =head1 SYNOPSIS |
| 87 | |
| 88 | perl -MO=Showlex[,SUBROUTINE] foo.pl |
| 89 | |
| 90 | =head1 DESCRIPTION |
| 91 | |
| 92 | When a subroutine name is provided in OPTIONS, prints the lexical |
| 93 | variables used in that subroutine. Otherwise, prints the file-scope |
| 94 | lexicals in the file. |
| 95 | |
| 96 | =head1 AUTHOR |
| 97 | |
| 98 | Malcolm Beattie, C<mbeattie@sable.ox.ac.uk> |
| 99 | |
| 100 | =cut |