1package B::Showlex;
2
3our $VERSION = '1.05';
4
5use strict;
6use B qw(svref_2object comppadlist class);
7use B::Terse ();
8use 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
21our $walkHandle = \*STDOUT;
22
23sub walk_output { # updates $walkHandle
24    $walkHandle = B::Concise::walk_output(@_);
25    #print "got $walkHandle";
26    #print $walkHandle "using it";
27    $walkHandle;
28}
29
30sub 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
48sub 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
60sub 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
66my ($newlex, $nosp1); # rendering state vars
67
68sub 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
77sub 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
92sub 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
99sub showlex_main {
100    showlex("comppadlist", comppadlist->ARRAY)	if !$newlex;
101    newlex ("main", comppadlist->ARRAY)		if  $newlex;
102}
103
104sub 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
1341;
135
136__END__
137
138=head1 NAME
139
140B::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
148When a comma-separated list of subroutine names is given as options, Showlex
149prints the lexical variables used in those subroutines.  Otherwise, it prints
150the file-scope lexicals in the file.
151
152=head1 EXAMPLES
153
154Traditional 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: (0x8caea4) undef
159 1: (0x9db0fb0) $i
160 2: (0x9db0f38) $j
161 3: (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
170New-style form:
171
172 $ perl -MO=Showlex,-newlex -e 'my ($i,$j,$k)=(1,"foo")'
173 main Pad has 4 entries
174 0: (0x8caea4) undef
175 1: (0xa0c4fb8) "$i" = NULL (0xa0b8234)
176 2: (0xa0c4f40) "$j" = NULL (0xa0c4f34)
177 3: (0xa0c4f58) "$k" = NULL (0xa0c4f4c)
178 -e syntax OK
179
180New 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: (0x998ffb0) "$i" = IV (0x9983234) 1
186 2: (0x998ff68) "$j" = PV (0x998ff5c) "foo"
187 3: (0x998ff80) "$k" = NULL (0x998ff74)
188
189Note that this example shows the values of the lexicals, whereas the other
190examples did not (as they're compile-time only).
191
192=head2 OPTIONS
193
194The C<-newlex> option produces a more readable C<< name => value >> format,
195and is shown in the second example above.
196
197The C<-nosp> option eliminates reporting of SPECIALs, such as C<0: SPECIAL
198#1 &PL_sv_undef> above.  Reporting of SPECIALs can sometimes overwhelm
199your declared lexicals.
200
201=head1 SEE ALSO
202
203L<B::Showlex> can also be used outside of the O framework, as in the third
204example.  See L<B::Concise> for a fuller explanation of reasons.
205
206=head1 TODO
207
208Some of the reported info, such as hex addresses, is not particularly
209valuable.  Other information would be more useful for the typical
210programmer, such as line-numbers, pad-slot reuses, etc..  Given this,
211-newlex is not a particularly good flag-name.
212
213=head1 AUTHOR
214
215Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
216
217=cut
218