Commit | Line | Data |
a798dbf2 |
1 | package B::Showlex; |
28b605d8 |
2 | |
cc02ea56 |
3 | our $VERSION = '1.01'; |
28b605d8 |
4 | |
a798dbf2 |
5 | use strict; |
6 | use B qw(svref_2object comppadlist class); |
7 | use B::Terse (); |
cc02ea56 |
8 | use B::Concise (); |
a798dbf2 |
9 | |
10 | # |
11 | # Invoke as |
12 | # perl -MO=Showlex,foo bar.pl |
13 | # to see the names of lexical variables used by &foo |
14 | # or as |
15 | # perl -MO=Showlex bar.pl |
16 | # to see the names of file scope lexicals used by bar.pl |
cc02ea56 |
17 | # |
18 | |
19 | |
20 | # borrowed from B::Concise |
21 | our $walkHandle = \*STDOUT; |
22 | |
23 | sub walk_output { # updates $walkHandle |
24 | $walkHandle = B::Concise::walk_output(@_); |
25 | #print "got $walkHandle"; |
26 | #print $walkHandle "using it"; |
27 | $walkHandle; |
28 | } |
a798dbf2 |
29 | |
0b40bd6d |
30 | sub shownamearray { |
31 | my ($name, $av) = @_; |
32 | my @els = $av->ARRAY; |
33 | my $count = @els; |
34 | my $i; |
cc02ea56 |
35 | print $walkHandle "$name has $count entries\n"; |
0b40bd6d |
36 | for ($i = 0; $i < $count; $i++) { |
0b40bd6d |
37 | my $sv = $els[$i]; |
38 | if (class($sv) ne "SPECIAL") { |
cc02ea56 |
39 | printf $walkHandle "$i: %s (0x%lx) %s\n", class($sv), $$sv, $sv->PVX; |
0b40bd6d |
40 | } else { |
cc02ea56 |
41 | printf $walkHandle "$i: %s\n", $sv->terse; |
42 | #printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv); |
0b40bd6d |
43 | } |
44 | } |
45 | } |
46 | |
47 | sub showvaluearray { |
a798dbf2 |
48 | my ($name, $av) = @_; |
49 | my @els = $av->ARRAY; |
50 | my $count = @els; |
51 | my $i; |
cc02ea56 |
52 | print $walkHandle "$name has $count entries\n"; |
a798dbf2 |
53 | for ($i = 0; $i < $count; $i++) { |
cc02ea56 |
54 | printf $walkHandle "$i: %s\n", $els[$i]->terse; |
55 | #print $walkHandle "$i: %s\n", B::Concise::concise_sv($els[$i]); |
a798dbf2 |
56 | } |
57 | } |
58 | |
59 | sub showlex { |
60 | my ($objname, $namesav, $valsav) = @_; |
0b40bd6d |
61 | shownamearray("Pad of lexical names for $objname", $namesav); |
62 | showvaluearray("Pad of lexical values for $objname", $valsav); |
a798dbf2 |
63 | } |
64 | |
cc02ea56 |
65 | sub newlex { # drop-in for showlex |
66 | my ($objname, $names, $vals) = @_; |
67 | my @names = $names->ARRAY; |
68 | my @vals = $vals->ARRAY; |
69 | my $count = @names; |
70 | print $walkHandle "$objname Pad has $count entries\n"; |
71 | printf $walkHandle "0: %s\n", $names[0]->terse; |
72 | for (my $i = 1; $i < $count; $i++) { |
73 | printf $walkHandle "$i: %s = %s\n", $names[$i]->terse, $vals[$i]->terse; |
74 | } |
75 | } |
76 | |
77 | my $newlex; # rendering state var |
78 | |
a798dbf2 |
79 | sub showlex_obj { |
80 | my ($objname, $obj) = @_; |
81 | $objname =~ s/^&main::/&/; |
cc02ea56 |
82 | showlex($objname, svref_2object($obj)->PADLIST->ARRAY) if !$newlex; |
83 | newlex ($objname, svref_2object($obj)->PADLIST->ARRAY) if $newlex; |
a798dbf2 |
84 | } |
85 | |
86 | sub showlex_main { |
87 | showlex("comppadlist", comppadlist->ARRAY); |
88 | } |
89 | |
90 | sub compile { |
cc02ea56 |
91 | my @options = grep(/^-/, @_); |
92 | my @args = grep(!/^-/, @_); |
93 | for my $o (@options) { |
94 | $newlex = 1 if $o eq "-newlex"; |
95 | } |
96 | |
97 | return \&showlex_main unless @args; |
98 | return sub { |
99 | foreach my $objname (@args) { |
100 | my $objref; |
101 | if (ref $objname) { |
102 | print $walkHandle "B::Showlex::compile($objname)\n"; |
103 | $objref = $objname; |
104 | } else { |
a798dbf2 |
105 | $objname = "main::$objname" unless $objname =~ /::/; |
cc02ea56 |
106 | print $walkHandle "$objname:\n"; |
107 | no strict 'refs'; |
108 | die "err: unknown function ($objname)\n" |
109 | unless *{$objname}{CODE}; |
110 | $objref = \&$objname; |
a798dbf2 |
111 | } |
cc02ea56 |
112 | showlex_obj($objname, $objref); |
a798dbf2 |
113 | } |
a798dbf2 |
114 | } |
115 | } |
116 | |
117 | 1; |
7f20e9dd |
118 | |
119 | __END__ |
120 | |
121 | =head1 NAME |
122 | |
123 | B::Showlex - Show lexical variables used in functions or files |
124 | |
125 | =head1 SYNOPSIS |
126 | |
127 | perl -MO=Showlex[,SUBROUTINE] foo.pl |
128 | |
129 | =head1 DESCRIPTION |
130 | |
131 | When a subroutine name is provided in OPTIONS, prints the lexical |
132 | variables used in that subroutine. Otherwise, prints the file-scope |
133 | lexicals in the file. |
134 | |
135 | =head1 AUTHOR |
136 | |
137 | Malcolm Beattie, C<mbeattie@sable.ox.ac.uk> |
138 | |
139 | =cut |