ext/B/B/Showlex.pm

   1 package B::Showlex;
   2 use strict;
   3 use B qw(svref_2object comppadlist class);
   4 use B::Terse ();
   5
   6 #
   7 # Invoke as
   8 #     perl -MO=Showlex,foo bar.pl
   9 # to see the names of lexical variables used by &foo
  10 # or as
  11 #     perl -MO=Showlex bar.pl
  12 # to see the names of file scope lexicals used by bar.pl
  13 #
  14
  15 sub shownamearray {
  16     my ($name, $av) = @_;
  17     my @els = $av->ARRAY;
  18     my $count = @els;
  19     my $i;
  20     print "$name has $count entries\n";
  21     for ($i = 0; $i < $count; $i++) {
  22         print "$i: ";
  23         my $sv = $els[$i];
  24         if (class($sv) ne "SPECIAL") {
  25             printf "%s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX;
  26         } else {
  27             $sv->terse;
  28         }
  29     }
  30 }
  31
  32 sub showvaluearray {
  33     my ($name, $av) = @_;
  34     my @els = $av->ARRAY;
  35     my $count = @els;
  36     my $i;
  37     print "$name has $count entries\n";
  38     for ($i = 0; $i < $count; $i++) {
  39         print "$i: ";
  40         $els[$i]->terse;
  41     }
  42 }
  43
  44 sub showlex {
  45     my ($objname, $namesav, $valsav) = @_;
  46     shownamearray("Pad of lexical names for $objname", $namesav);
  47     showvaluearray("Pad of lexical values for $objname", $valsav);
  48 }
  49
  50 sub showlex_obj {
  51     my ($objname, $obj) = @_;
  52     $objname =~ s/^&main::/&/;
  53     showlex($objname, svref_2object($obj)->PADLIST->ARRAY);
  54 }
  55
  56 sub showlex_main {
  57     showlex("comppadlist", comppadlist->ARRAY);
  58 }
  59
  60 sub compile {
  61     my @options = @_;
  62     if (@options) {
  63         return sub {
  64             my $objname;
  65             foreach $objname (@options) {
  66                 $objname = "main::$objname" unless $objname =~ /::/;
  67                 eval "showlex_obj('&$objname', \\&$objname)";
  68             }
  69         }
  70     } else {
  71         return \&showlex_main;
  72     }
  73 }
  74
  75 1;
  76
  77 __END__
  78
  79 =head1 NAME
  80
  81 B::Showlex - Show lexical variables used in functions or files
  82
  83 =head1 SYNOPSIS
  84
  85         perl -MO=Showlex[,SUBROUTINE] foo.pl
  86
  87 =head1 DESCRIPTION
  88
  89 When a subroutine name is provided in OPTIONS, prints the lexical
  90 variables used in that subroutine.  Otherwise, prints the file-scope
  91 lexicals in the file.
  92
  93 =head1 AUTHOR
  94
  95 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
  96
  97 =cut