| 1 | package B::Showlex; |
| 2 | |
| 3 | our $VERSION = '1.02'; |
| 4 | |
| 5 | use strict; |
| 6 | use B qw(svref_2object comppadlist class); |
| 7 | use B::Terse (); |
| 8 | use B::Concise (); |
| 9 | |
| 10 | # |
| 11 | # Invoke as |
| 12 | # perl -MO=Showlex,foo bar.pl |
| 13 | # to see the names of lexical variables used by &foo |
| 14 | # or as |
| 15 | # perl -MO=Showlex bar.pl |
| 16 | # to see the names of file scope lexicals used by bar.pl |
| 17 | # |
| 18 | |
| 19 | |
| 20 | # borrowed from B::Concise |
| 21 | our $walkHandle = \*STDOUT; |
| 22 | |
| 23 | sub walk_output { # updates $walkHandle |
| 24 | $walkHandle = B::Concise::walk_output(@_); |
| 25 | #print "got $walkHandle"; |
| 26 | #print $walkHandle "using it"; |
| 27 | $walkHandle; |
| 28 | } |
| 29 | |
| 30 | sub shownamearray { |
| 31 | my ($name, $av) = @_; |
| 32 | my @els = $av->ARRAY; |
| 33 | my $count = @els; |
| 34 | my $i; |
| 35 | print $walkHandle "$name has $count entries\n"; |
| 36 | for ($i = 0; $i < $count; $i++) { |
| 37 | my $sv = $els[$i]; |
| 38 | if (class($sv) ne "SPECIAL") { |
| 39 | printf $walkHandle "$i: %s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX; |
| 40 | } else { |
| 41 | printf $walkHandle "$i: %s\n", $sv->terse; |
| 42 | #printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv); |
| 43 | } |
| 44 | } |
| 45 | } |
| 46 | |
| 47 | sub showvaluearray { |
| 48 | my ($name, $av) = @_; |
| 49 | my @els = $av->ARRAY; |
| 50 | my $count = @els; |
| 51 | my $i; |
| 52 | print $walkHandle "$name has $count entries\n"; |
| 53 | for ($i = 0; $i < $count; $i++) { |
| 54 | printf $walkHandle "$i: %s\n", $els[$i]->terse; |
| 55 | #print $walkHandle "$i: %s\n", B::Concise::concise_sv($els[$i]); |
| 56 | } |
| 57 | } |
| 58 | |
| 59 | sub showlex { |
| 60 | my ($objname, $namesav, $valsav) = @_; |
| 61 | shownamearray("Pad of lexical names for $objname", $namesav); |
| 62 | showvaluearray("Pad of lexical values for $objname", $valsav); |
| 63 | } |
| 64 | |
| 65 | my ($newlex, $nosp1); # rendering state vars |
| 66 | |
| 67 | sub newlex { # drop-in for showlex |
| 68 | my ($objname, $names, $vals) = @_; |
| 69 | my @names = $names->ARRAY; |
| 70 | my @vals = $vals->ARRAY; |
| 71 | my $count = @names; |
| 72 | print $walkHandle "$objname Pad has $count entries\n"; |
| 73 | printf $walkHandle "0: %s\n", $names[0]->terse unless $nosp1; |
| 74 | for (my $i = 1; $i < $count; $i++) { |
| 75 | printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse |
| 76 | unless $nosp1 and $names[$i]->terse =~ /SPECIAL/; |
| 77 | } |
| 78 | } |
| 79 | |
| 80 | sub showlex_obj { |
| 81 | my ($objname, $obj) = @_; |
| 82 | $objname =~ s/^&main::/&/; |
| 83 | showlex($objname, svref_2object($obj)->PADLIST->ARRAY) if !$newlex; |
| 84 | newlex ($objname, svref_2object($obj)->PADLIST->ARRAY) if $newlex; |
| 85 | } |
| 86 | |
| 87 | sub showlex_main { |
| 88 | showlex("comppadlist", comppadlist->ARRAY) if !$newlex; |
| 89 | newlex ("main", comppadlist->ARRAY) if $newlex; |
| 90 | } |
| 91 | |
| 92 | sub compile { |
| 93 | my @options = grep(/^-/, @_); |
| 94 | my @args = grep(!/^-/, @_); |
| 95 | for my $o (@options) { |
| 96 | $newlex = 1 if $o eq "-newlex"; |
| 97 | $nosp1 = 1 if $o eq "-nosp"; |
| 98 | } |
| 99 | |
| 100 | return \&showlex_main unless @args; |
| 101 | return sub { |
| 102 | my $objref; |
| 103 | foreach my $objname (@args) { |
| 104 | next unless $objname; # skip nulls w/o carping |
| 105 | |
| 106 | if (ref $objname) { |
| 107 | print $walkHandle "B::Showlex::compile($objname)\n"; |
| 108 | $objref = $objname; |
| 109 | } else { |
| 110 | $objname = "main::$objname" unless $objname =~ /::/; |
| 111 | print $walkHandle "$objname:\n"; |
| 112 | no strict 'refs'; |
| 113 | die "err: unknown function ($objname)\n" |
| 114 | unless *{$objname}{CODE}; |
| 115 | $objref = \&$objname; |
| 116 | } |
| 117 | showlex_obj($objname, $objref); |
| 118 | } |
| 119 | } |
| 120 | } |
| 121 | |
| 122 | 1; |
| 123 | |
| 124 | __END__ |
| 125 | |
| 126 | =head1 NAME |
| 127 | |
| 128 | B::Showlex - Show lexical variables used in functions or files |
| 129 | |
| 130 | =head1 SYNOPSIS |
| 131 | |
| 132 | perl -MO=Showlex[,-OPTIONS][,SUBROUTINE] foo.pl |
| 133 | |
| 134 | =head1 DESCRIPTION |
| 135 | |
| 136 | When a comma-separated list of subroutine names is given as options, Showlex |
| 137 | prints the lexical variables used in those subroutines. Otherwise, it prints |
| 138 | the file-scope lexicals in the file. |
| 139 | |
| 140 | =head1 EXAMPLES |
| 141 | |
| 142 | Traditional form: |
| 143 | |
| 144 | $ perl -MO=Showlex -e 'my ($i,$j,$k)=(1,"foo")' |
| 145 | Pad of lexical names for comppadlist has 4 entries |
| 146 | 0: SPECIAL #1 &PL_sv_undef |
| 147 | 1: PVNV (0x9db0fb0) $i |
| 148 | 2: PVNV (0x9db0f38) $j |
| 149 | 3: PVNV (0x9db0f50) $k |
| 150 | Pad of lexical values for comppadlist has 5 entries |
| 151 | 0: SPECIAL #1 &PL_sv_undef |
| 152 | 1: NULL (0x9da4234) |
| 153 | 2: NULL (0x9db0f2c) |
| 154 | 3: NULL (0x9db0f44) |
| 155 | 4: NULL (0x9da4264) |
| 156 | -e syntax OK |
| 157 | |
| 158 | New-style form: |
| 159 | |
| 160 | $ perl -MO=Showlex,-newlex -e 'my ($i,$j,$k)=(1,"foo")' |
| 161 | main Pad has 4 entries |
| 162 | 0: SPECIAL #1 &PL_sv_undef |
| 163 | 1: PVNV (0xa0c4fb8) "$i" = NULL (0xa0b8234) |
| 164 | 2: PVNV (0xa0c4f40) "$j" = NULL (0xa0c4f34) |
| 165 | 3: PVNV (0xa0c4f58) "$k" = NULL (0xa0c4f4c) |
| 166 | -e syntax OK |
| 167 | |
| 168 | New form, no specials, outside O framework: |
| 169 | |
| 170 | $ perl -MB::Showlex -e \ |
| 171 | 'my ($i,$j,$k)=(1,"foo"); B::Showlex::compile(-newlex,-nosp)->()' |
| 172 | main Pad has 4 entries |
| 173 | 1: PVNV (0x998ffb0) "$i" = IV (0x9983234) 1 |
| 174 | 2: PVNV (0x998ff68) "$j" = PV (0x998ff5c) "foo" |
| 175 | 3: PVNV (0x998ff80) "$k" = NULL (0x998ff74) |
| 176 | |
| 177 | Note that this example shows the values of the lexicals, whereas the other |
| 178 | examples did not (as they're compile-time only). |
| 179 | |
| 180 | =head2 OPTIONS |
| 181 | |
| 182 | The C<-newlex> option produces a more readable C<< name => value >> format, |
| 183 | and is shown in the second example above. |
| 184 | |
| 185 | The C<-nosp> option eliminates reporting of SPECIALs, such as C<0: SPECIAL |
| 186 | #1 &PL_sv_undef> above. Reporting of SPECIALs can sometimes overwhelm |
| 187 | your declared lexicals. |
| 188 | |
| 189 | =head1 SEE ALSO |
| 190 | |
| 191 | C<B::Showlex> can also be used outside of the O framework, as in the third |
| 192 | example. See C<B::Concise> for a fuller explanation of reasons. |
| 193 | |
| 194 | =head1 TODO |
| 195 | |
| 196 | Some of the reported info, such as hex addresses, is not particularly |
| 197 | valuable. Other information would be more useful for the typical |
| 198 | programmer, such as line-numbers, pad-slot reuses, etc.. Given this, |
| 199 | -newlex isnt a particularly good flag-name. |
| 200 | |
| 201 | =head1 AUTHOR |
| 202 | |
| 203 | Malcolm Beattie, C<mbeattie@sable.ox.ac.uk> |
| 204 | |
| 205 | =cut |