ext/B/B/Showlex.pm

   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