Commit | Line | Data |
---|---|---|
a798dbf2 | 1 | package B::Showlex; |
28b605d8 JH |
2 | |
3 | our $VERSION = '1.00'; | |
4 | ||
a798dbf2 MB |
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 | ||
0b40bd6d RH |
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 { | |
a798dbf2 MB |
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) = @_; | |
0b40bd6d RH |
49 | shownamearray("Pad of lexical names for $objname", $namesav); |
50 | showvaluearray("Pad of lexical values for $objname", $valsav); | |
a798dbf2 MB |
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; | |
7f20e9dd GS |
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 |