ext/B/B/Showlex.pm

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