[Summary view] [Print] [Text view]

   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