PERL   37
showlex
Guest on 14th September 2023 01:22:01 PM


  1. package B::Showlex;
  2.  
  3. our $VERSION = '1.03';
  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. L<B::Showlex> can also be used outside of the O framework, as in the third
  192. example.  See L<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
Raw Paste

Login or Register to edit or fork this paste. It's free.