This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #123223] Make PADNAME a separate type
[perl5.git] / ext / B / B / Showlex.pm
1 package B::Showlex;
2
3 our $VERSION = '1.05';
4
5 use strict;
6 use B qw(svref_2object comppadlist class);
7 use B::Terse ();
8 use B::Concise ();
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
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 }
29
30 sub shownamearray {
31     my ($name, $av) = @_;
32     my @els = $av->ARRAY;
33     my $count = @els;
34     my $i;
35     print $walkHandle "$name has $count entries\n";
36     for ($i = 0; $i < $count; $i++) {
37         my $sv = $els[$i];
38         if (class($sv) ne "SPECIAL") {
39             printf $walkHandle "$i: (0x%lx) %s\n",
40                                 $$sv, $sv->PVX // "undef" || "const";
41         } else {
42             printf $walkHandle "$i: %s\n", $sv->terse;
43             #printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv);
44         }
45     }
46 }
47
48 sub showvaluearray {
49     my ($name, $av) = @_;
50     my @els = $av->ARRAY;
51     my $count = @els;
52     my $i;
53     print $walkHandle "$name has $count entries\n";
54     for ($i = 0; $i < $count; $i++) {
55         printf $walkHandle "$i: %s\n", $els[$i]->terse;
56         #print $walkHandle "$i: %s\n", B::Concise::concise_sv($els[$i]);
57     }
58 }
59
60 sub showlex {
61     my ($objname, $namesav, $valsav) = @_;
62     shownamearray("Pad of lexical names for $objname", $namesav);
63     showvaluearray("Pad of lexical values for $objname", $valsav);
64 }
65
66 my ($newlex, $nosp1); # rendering state vars
67
68 sub padname_terse {
69     my $name = shift;
70     return $name->terse if class($name) eq 'SPECIAL';
71     my $str = $name->PVX;
72     return sprintf "(0x%lx) %s",
73                $$name,
74                length $str ? qq'"$str"' : defined $str ? "const" : 'undef';
75 }
76
77 sub newlex { # drop-in for showlex
78     my ($objname, $names, $vals) = @_;
79     my @names = $names->ARRAY;
80     my @vals  = $vals->ARRAY;
81     my $count = @names;
82     print $walkHandle "$objname Pad has $count entries\n";
83     printf $walkHandle "0: %s\n", padname_terse($names[0]) unless $nosp1;
84     for (my $i = 1; $i < $count; $i++) {
85         printf $walkHandle "$i: %s = %s\n", padname_terse($names[$i]),
86                                             $vals[$i]->terse,
87             unless $nosp1
88                and class($names[$i]) eq 'SPECIAL' || !$names[$i]->LEN;
89     }
90 }
91
92 sub showlex_obj {
93     my ($objname, $obj) = @_;
94     $objname =~ s/^&main::/&/;
95     showlex($objname, svref_2object($obj)->PADLIST->ARRAY) if !$newlex;
96     newlex ($objname, svref_2object($obj)->PADLIST->ARRAY) if  $newlex;
97 }
98
99 sub showlex_main {
100     showlex("comppadlist", comppadlist->ARRAY)  if !$newlex;
101     newlex ("main", comppadlist->ARRAY)         if  $newlex;
102 }
103
104 sub compile {
105     my @options = grep(/^-/, @_);
106     my @args = grep(!/^-/, @_);
107     for my $o (@options) {
108         $newlex = 1 if $o eq "-newlex";
109         $nosp1  = 1 if $o eq "-nosp";
110     }
111
112     return \&showlex_main unless @args;
113     return sub {
114         my $objref;
115         foreach my $objname (@args) {
116             next unless $objname;       # skip nulls w/o carping
117
118             if (ref $objname) {
119                 print $walkHandle "B::Showlex::compile($objname)\n";
120                 $objref = $objname;
121             } else {
122                 $objname = "main::$objname" unless $objname =~ /::/;
123                 print $walkHandle "$objname:\n";
124                 no strict 'refs';
125                 die "err: unknown function ($objname)\n"
126                     unless *{$objname}{CODE};
127                 $objref = \&$objname;
128             }
129             showlex_obj($objname, $objref);
130         }
131     }
132 }
133
134 1;
135
136 __END__
137
138 =head1 NAME
139
140 B::Showlex - Show lexical variables used in functions or files
141
142 =head1 SYNOPSIS
143
144         perl -MO=Showlex[,-OPTIONS][,SUBROUTINE] foo.pl
145
146 =head1 DESCRIPTION
147
148 When a comma-separated list of subroutine names is given as options, Showlex
149 prints the lexical variables used in those subroutines.  Otherwise, it prints
150 the file-scope lexicals in the file.
151
152 =head1 EXAMPLES
153
154 Traditional form:
155
156  $ perl -MO=Showlex -e 'my ($i,$j,$k)=(1,"foo")'
157  Pad of lexical names for comppadlist has 4 entries
158  0: SPECIAL #1 &PL_sv_undef
159  1: PVNV (0x9db0fb0) $i
160  2: PVNV (0x9db0f38) $j
161  3: PVNV (0x9db0f50) $k
162  Pad of lexical values for comppadlist has 5 entries
163  0: SPECIAL #1 &PL_sv_undef
164  1: NULL (0x9da4234)
165  2: NULL (0x9db0f2c)
166  3: NULL (0x9db0f44)
167  4: NULL (0x9da4264)
168  -e syntax OK
169
170 New-style form:
171
172  $ perl -MO=Showlex,-newlex -e 'my ($i,$j,$k)=(1,"foo")'
173  main Pad has 4 entries
174  0: SPECIAL #1 &PL_sv_undef
175  1: PVNV (0xa0c4fb8) "$i" = NULL (0xa0b8234)
176  2: PVNV (0xa0c4f40) "$j" = NULL (0xa0c4f34)
177  3: PVNV (0xa0c4f58) "$k" = NULL (0xa0c4f4c)
178  -e syntax OK
179
180 New form, no specials, outside O framework:
181
182  $ perl -MB::Showlex -e \
183     'my ($i,$j,$k)=(1,"foo"); B::Showlex::compile(-newlex,-nosp)->()'
184  main Pad has 4 entries
185  1: PVNV (0x998ffb0) "$i" = IV (0x9983234) 1
186  2: PVNV (0x998ff68) "$j" = PV (0x998ff5c) "foo"
187  3: PVNV (0x998ff80) "$k" = NULL (0x998ff74)
188
189 Note that this example shows the values of the lexicals, whereas the other
190 examples did not (as they're compile-time only).
191
192 =head2 OPTIONS
193
194 The C<-newlex> option produces a more readable C<< name => value >> format,
195 and is shown in the second example above.
196
197 The C<-nosp> option eliminates reporting of SPECIALs, such as C<0: SPECIAL
198 #1 &PL_sv_undef> above.  Reporting of SPECIALs can sometimes overwhelm
199 your declared lexicals.
200
201 =head1 SEE ALSO
202
203 L<B::Showlex> can also be used outside of the O framework, as in the third
204 example.  See L<B::Concise> for a fuller explanation of reasons.
205
206 =head1 TODO
207
208 Some of the reported info, such as hex addresses, is not particularly
209 valuable.  Other information would be more useful for the typical
210 programmer, such as line-numbers, pad-slot reuses, etc..  Given this,
211 -newlex is not a particularly good flag-name.
212
213 =head1 AUTHOR
214
215 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
216
217 =cut