ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.pm
(Generate patch)

Comparing Devel-FindRef/FindRef.pm (file contents):
Revision 1.15 by root, Sat Jul 19 01:38:57 2008 UTC vs.
Revision 1.30 by root, Fri May 16 07:43:52 2014 UTC

1package Devel::FindRef; 1package Devel::FindRef;
2 2
3no warnings; # I hate warning nazis 3use common::sense;
4use strict;
5 4
6use XSLoader; 5use XSLoader;
7use Scalar::Util; 6use Scalar::Util;
8 7
9BEGIN { 8BEGIN {
10 our $VERSION = '1.31'; 9 our $VERSION = '1.43';
11 XSLoader::load __PACKAGE__, $VERSION; 10 XSLoader::load __PACKAGE__, $VERSION;
12} 11}
13 12
14=head1 NAME 13=head1 NAME
15 14
16Devel::FindRef - where is that reference to my variable hiding? 15Devel::FindRef - where is that reference to my variable hiding?
17 16
18=head1 SYNOPSIS 17=head1 SYNOPSIS
19 18
20 use Devel::FindRef; 19 use Devel::FindRef;
20
21 print Devel::FindRef::track \$some_variable;
21 22
22=head1 DESCRIPTION 23=head1 DESCRIPTION
23 24
24Tracking down reference problems (e.g. you expect some object to be 25Tracking down reference problems (e.g. you expect some object to be
25destroyed, but there are still references to it that keep it alive) can be 26destroyed, but there are still references to it that keep it alive) can be
… …
29The C<track> function can help track down some of those references back to 30The C<track> function can help track down some of those references back to
30the variables containing them. 31the variables containing them.
31 32
32For example, for this fragment: 33For example, for this fragment:
33 34
34 package Test; 35 package Test;
36
37 use Devel::FindRef;
38 use Scalar::Util;
35 39
36 our $var = "hi\n"; 40 our $var = "hi\n";
37 my $x = \$var; 41 my $global_my = \$var;
38 our %hash = (ukukey => \$var); 42 our %global_hash = (ukukey => \$var);
39 our $hash2 = {ukukey2 => \$var}; 43 our $global_hashref = { ukukey2 => \$var };
40 44
41 sub testsub { 45 sub testsub {
42 my $local = $hash2; 46 my $testsub_local = $global_hashref;
43 print Devel::FindRef::track \$var; 47 print Devel::FindRef::track \$var;
44 } 48 }
45 49
46 testsub; 50 my $closure = sub {
51 my $closure_var = \$_[0];
52 Scalar::Util::weaken (my $weak_ref = \$var);
53 testsub;
54 };
55
56 $closure->($var);
47 57
48The output is as follows (or similar to this, in case I forget to update 58The output is as follows (or similar to this, in case I forget to update
49the manpage after some changes): 59the manpage after some changes):
50 60
51 SCALAR(0x814ece8) is 61 SCALAR(0x7cc888) [refcount 6] is
62 +- referenced by REF(0x8abcc8) [refcount 1], which is
63 | the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
64 | +- the closure created at tst:18.
65 | +- referenced by REF(0x7d3c58) [refcount 1], which is
66 | | the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
67 | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is
68 | | | the global &Test::testsub.
69 | | +- the main body of the program.
70 | +- the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before.
71 +- referenced by REF(0x7cc7c8) [refcount 1], which is
72 | the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before.
52 +- in the global $Test::var. 73 +- the global $Test::var.
53 +- referenced by REF(0x814f9e4), which is 74 +- referenced by REF(0x7cc558) [refcount 1], which is
54 | in the lexical '$x' in CODE(0x814ed78), which is 75 | the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is
55 | the containing scope for CODE(0x820c4b0), which is 76 | +- referenced by REF(0x8abad0) [refcount 1], which is
56 | in the global &Test::testsub. 77 | | the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before.
78 | +- referenced by REF(0x8ab4f0) [refcount 1], which is
79 | the global $Test::global_hashref.
57 +- referenced by REF(0x814ed6c), which is 80 +- referenced by REF(0x7ae518) [refcount 1], which is
58 | in the member 'ukukey' of HASH(0x81da20c), which is 81 | the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is
59 | in the global %Test::hash. 82 | the global %Test::global_hash.
60 +- referenced by REF(0x814ec28), which is 83 +- referenced by REF(0x7ae2f0) [refcount 1], which is
61 | not found anywhere I looked :( 84 a temporary on the stack.
62 +- referenced by REF(0x814eb44), which is
63 in the member 'ukukey2' of HASH(0x814f99c), which is
64 +- referenced by REF(0x820c450), which is
65 | in the lexical '$local' in CODE(0x820c4b0), which was seen before.
66 +- referenced by REF(0x820c204), which is
67 in the global $Test::hash2.
68 85
69It is a bit convoluted to read, but basically it says that the value 86It is a bit convoluted to read, but basically it says that the value
70stored in C<$var> can be found: 87stored in C<$var> is referenced by:
71 88
72=over 4 89=over 4
73 90
74=item - in some variable C<$x> whose origin is not known (I frankly have no 91=item - the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
75idea why, hints accepted). 92closure, which in turn is used quite a bit.
76 93
77=item - in the hash element with key C<ukukey> in the hash stored in C<%Test::hash>. 94=item - the package-level lexical C<$global_my>.
78 95
79=item - in the global variable named C<$Test::var>. 96=item - the global package variable named C<$Test::var>.
80 97
81=item - in the hash element C<ukukey2>, in the hash in the my variable 98=item - the hash element C<ukukey2>, in the hash in the my variable
82C<$local> in the sub C<Test::testsub> and also in the hash referenced by 99C<$testsub_local> in the sub C<Test::testsub> and also in the hash
100C<$referenced by Test::hash2>.
101
102=item - the hash element with key C<ukukey> in the hash stored in
83C<$Test::hash2>. 103C<%Test::hash>.
104
105=item - some anonymous mortalised reference on the stack (which is caused
106by calling C<track> with the expression C<\$var>, which creates the
107reference).
84 108
85=back 109=back
110
111And all these account for six reference counts.
86 112
87=head1 EXPORTS 113=head1 EXPORTS
88 114
89None. 115None.
90 116
… …
96 122
97Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and 123Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and
98return a descriptive string. C<$ref> can point at any perl value, be it 124return a descriptive string. C<$ref> can point at any perl value, be it
99anonymous sub, hash, array, scalar etc. 125anonymous sub, hash, array, scalar etc.
100 126
101This is the function you most often use. 127This is the function you most likely want to use when tracking down
128references.
102 129
103=cut 130=cut
104 131
105sub find($); 132sub find($);
133
134sub _f($) {
135 "$_[0] [refcount " . (_refcnt $_[0]) . "]"
136}
106 137
107sub track { 138sub track {
108 my ($ref, $depth) = @_; 139 my ($ref, $depth) = @_;
109 @_ = (); 140 @_ = ();
110 141
… …
118 149
119 if ($depth) { 150 if ($depth) {
120 my (@about) = find $$refref; 151 my (@about) = find $$refref;
121 if (@about) { 152 if (@about) {
122 for my $about (@about) { 153 for my $about (@about) {
154 $about->[0] =~ s/([^\x20-\x7e])/sprintf "\\{%02x}", ord $1/ge;
123 $buf .= "$indent" . (@about > 1 ? "+- " : " ") . $about->[0]; 155 $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
124 if (@$about > 1) { 156 if (@$about > 1) {
125 if ($seen{ref2ptr $about->[1]}++) { 157 if ($seen{ref2ptr $about->[1]}++) {
126 $buf .= " $about->[1], which was seen before.\n"; 158 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
127 } else { 159 } else {
128 $buf .= " $about->[1], which is\n"; 160 $buf .= " " . (_f $about->[1]) . ", which is\n";
129 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| "); 161 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
130 } 162 }
131 } else { 163 } else {
132 $buf .= ".\n"; 164 $buf .= ".\n";
133 } 165 }
… …
138 } else { 170 } else {
139 $buf .= "$indent not referenced within the search depth.\n"; 171 $buf .= "$indent not referenced within the search depth.\n";
140 } 172 }
141 }; 173 };
142 174
143 $buf .= "$ref is\n"; 175 $buf .= (_f $ref) . " is\n";
176
144 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, ""); 177 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
145 $buf 178 $buf
146} 179}
147 180
148=item @references = Devel::FindRef::find $ref 181=item @references = Devel::FindRef::find $ref
… …
158=cut 191=cut
159 192
160sub find($) { 193sub find($) {
161 my ($about, $excl) = &find_; 194 my ($about, $excl) = &find_;
162 my %excl = map +($_ => undef), @$excl; 195 my %excl = map +($_ => undef), @$excl;
163 grep !exists $excl{ref2ptr $_->[1]}, @$about 196 grep !($#$_ && exists $excl{ref2ptr $_->[1]}), @$about
164} 197}
165 198
166=item $ref = Devel::FindRef::ptr2ref $integer 199=item $ref = Devel::FindRef::ptr2ref $integer
167 200
168Sometimes you know (from debugging output) the address of a perl scalar 201Sometimes you know (from debugging output) the address of a perl value you
169you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used 202are interested in (e.g. C<HASH(0x176ff70)>). This function can be used to
170to turn the address into a reference to that scalar. It is quite safe to 203turn the address into a reference to that value. It is quite safe to call
171call on valid addresses, but extremely dangerous to call on invalid ones. 204on valid addresses, but extremely dangerous to call on invalid ones. I<No
205checks whatsoever will be done>, so don't use this unless you really know
206the value is the address of a valid perl value.
172 207
173 # we know that HASH(0x176ff70) exists, so turn it into a hashref: 208 # we know that HASH(0x176ff70) exists, so turn it into a hashref:
174 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70; 209 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
175 210
176=item $ref = Devel::FindRef::ref2ptr $reference 211=item $ptr = Devel::FindRef::ref2ptr $reference
177 212
178The opposite of C<ptr2ref>, above: returns the internal address of the 213The opposite of C<ptr2ref>, above: returns the internal address of the
179value pointed to by the passed reference. I<No checks whatsoever will be 214value pointed to by the passed reference. This function is safe to call on
180done>, so don't use this. 215anything, and returns the same value taht a normal reference would if used
216in a numeric context.
181 217
182=back 218=back
183 219
184=head1 ENVIRONMENT VARIABLES 220=head1 ENVIRONMENT VARIABLES
185 221
186You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an 222You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
187integer to override the default depth in C<track>. If a call explicitly 223integer to override the default depth in C<track>. If a call explicitly
188specified a depth it is not overridden. 224specifies a depth, it is not overridden.
189 225
190=head1 AUTHOR 226=head1 AUTHOR
191 227
192Marc Lehmann <pcg@goof.com>. 228Marc Lehmann <pcg@goof.com>.
193 229
194=head1 BUGS
195
196Only code values, arrays, hashes, scalars and magic are being looked at.
197
198This is a quick hack only.
199
200=head1 COPYRIGHT AND LICENSE 230=head1 COPYRIGHT AND LICENSE
201 231
202Copyright (C) 2007 by Marc Lehmann. 232Copyright (C) 2007, 2008, 2009, 2013 by Marc Lehmann.
203 233
204This library is free software; you can redistribute it and/or modify 234This library is free software; you can redistribute it and/or modify
205it under the same terms as Perl itself, either Perl version 5.8.8 or, 235it under the same terms as Perl itself, either Perl version 5.8.8 or,
206at your option, any later version of Perl 5 you may have available. 236at your option, any later version of Perl 5 you may have available.
207 237

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines