ext/B/B/Showlex.pm

   1 package B::Showlex;
   2
   3 our $VERSION = '1.01';
   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 sub newlex { # drop-in for showlex
  66     my ($objname, $names, $vals) = @_;
  67     my @names = $names->ARRAY;
  68     my @vals  = $vals->ARRAY;
  69     my $count = @names;
  70     print $walkHandle "$objname Pad has $count entries\n";
  71     printf $walkHandle "0: %s\n", $names[0]->terse;
  72     for (my $i = 1; $i < $count; $i++) {
  73         printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse;
  74     }
  75 }
  76
  77 my $newlex; # rendering state var
  78
  79 sub showlex_obj {
  80     my ($objname, $obj) = @_;
  81     $objname =~ s/^&main::/&/;
  82     showlex($objname, svref_2object($obj)->PADLIST->ARRAY) if !$newlex;
  83     newlex ($objname, svref_2object($obj)->PADLIST->ARRAY) if  $newlex;
  84 }
  85
  86 sub showlex_main {
  87     showlex("comppadlist", comppadlist->ARRAY);
  88 }
  89
  90 sub compile {
  91     my @options = grep(/^-/, @_);
  92     my @args = grep(!/^-/, @_);
  93     for my $o (@options) {
  94         $newlex = 1 if $o eq "-newlex";
  95     }
  96
  97     return \&showlex_main unless @args;
  98     return sub {
  99         foreach my $objname (@args) {
 100             my $objref;
 101             if (ref $objname) {
 102                 print $walkHandle "B::Showlex::compile($objname)\n";
 103                 $objref = $objname;
 104             } else {
 105                 $objname = "main::$objname" unless $objname =~ /::/;
 106                 print $walkHandle "$objname:\n";
 107                 no strict 'refs';
 108                 die "err: unknown function ($objname)\n"
 109                     unless *{$objname}{CODE};
 110                 $objref = \&$objname;
 111             }
 112             showlex_obj($objname, $objref);
 113         }
 114     }
 115 }
 116
 117 1;
 118
 119 __END__
 120
 121 =head1 NAME
 122
 123 B::Showlex - Show lexical variables used in functions or files
 124
 125 =head1 SYNOPSIS
 126
 127         perl -MO=Showlex[,SUBROUTINE] foo.pl
 128
 129 =head1 DESCRIPTION
 130
 131 When a subroutine name is provided in OPTIONS, prints the lexical
 132 variables used in that subroutine.  Otherwise, prints the file-scope
 133 lexicals in the file.
 134
 135 =head1 AUTHOR
 136
 137 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
 138
 139 =cut