home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _316de473596581ef4e89d5edc24edee2 < prev    next >
Text File  |  2004-06-01  |  2KB  |  101 lines
  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
  101.