Commit | Line | Data |
---|---|---|
a798dbf2 | 1 | package B::Showlex; |
28b605d8 | 2 | |
cc02ea56 | 3 | our $VERSION = '1.01'; |
28b605d8 | 4 | |
a798dbf2 MB |
5 | use strict; |
6 | use B qw(svref_2object comppadlist class); | |
7 | use B::Terse (); | |
cc02ea56 | 8 | use B::Concise (); |
a798dbf2 MB |
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 JC |
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 RH |
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 RH |
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 JC |
41 | printf $walkHandle "$i: %s\n", $sv->terse; |
42 | #printf $walkHandle "$i: %s\n", B::Concise::concise_sv($sv); | |
0b40bd6d RH |
43 | } |
44 | } | |
45 | } | |
46 | ||
47 | sub showvaluearray { | |
a798dbf2 MB |
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 JC |
54 | printf $walkHandle "$i: %s\n", $els[$i]->terse; |
55 | #print $walkHandle "$i: %s\n", B::Concise::concise_sv($els[$i]); | |
a798dbf2 MB |
56 | } |
57 | } | |
58 | ||
59 | sub showlex { | |
60 | my ($objname, $namesav, $valsav) = @_; | |
0b40bd6d RH |
61 | shownamearray("Pad of lexical names for $objname", $namesav); |
62 | showvaluearray("Pad of lexical values for $objname", $valsav); | |
a798dbf2 MB |
63 | } |
64 | ||
cc02ea56 JC |
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 MB |
79 | sub showlex_obj { |
80 | my ($objname, $obj) = @_; | |
81 | $objname =~ s/^&main::/&/; | |
cc02ea56 JC |
82 | showlex($objname, svref_2object($obj)->PADLIST->ARRAY) if !$newlex; |
83 | newlex ($objname, svref_2object($obj)->PADLIST->ARRAY) if $newlex; | |
a798dbf2 MB |
84 | } |
85 | ||
86 | sub showlex_main { | |
87 | showlex("comppadlist", comppadlist->ARRAY); | |
88 | } | |
89 | ||
90 | sub compile { | |
cc02ea56 JC |
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 JC |
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 MB |
114 | } |
115 | } | |
116 | ||
117 | 1; | |
7f20e9dd GS |
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 |