1package B::Showlex;
2
3our $VERSION = '1.02';
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: %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
47sub 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
59sub 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
65my ($newlex, $nosp1); # rendering state vars
66
67sub 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
80sub 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
87sub showlex_main {
88    showlex("comppadlist", comppadlist->ARRAY)	if !$newlex;
89    newlex ("main", comppadlist->ARRAY)		if  $newlex;
90}
91
92sub 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
1221;
123
124__END__
125
126=head1 NAME
127
128B::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
136When a comma-separated list of subroutine names is given as options, Showlex
137prints the lexical variables used in those subroutines.  Otherwise, it prints
138the file-scope lexicals in the file.
139
140=head1 EXAMPLES
141
142Traditional 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
158New-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
168New 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
177Note that this example shows the values of the lexicals, whereas the other
178examples did not (as they're compile-time only).
179
180=head2 OPTIONS
181
182The C<-newlex> option produces a more readable C<< name => value >> format,
183and is shown in the second example above.
184
185The C<-nosp> option eliminates reporting of SPECIALs, such as C<0: SPECIAL
186#1 &PL_sv_undef> above.  Reporting of SPECIALs can sometimes overwhelm
187your declared lexicals.
188
189=head1 SEE ALSO
190
191C<B::Showlex> can also be used outside of the O framework, as in the third
192example.  See C<B::Concise> for a fuller explanation of reasons.
193
194=head1 TODO
195
196Some of the reported info, such as hex addresses, is not particularly
197valuable.  Other information would be more useful for the typical
198programmer, such as line-numbers, pad-slot reuses, etc..  Given this,
199-newlex isnt a particularly good flag-name.
200
201=head1 AUTHOR
202
203Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
204
205=cut
206