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