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