ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.pm
Revision: 1.24
Committed: Fri Aug 28 20:30:07 2009 UTC (14 years, 8 months ago) by root
Branch: MAIN
CVS Tags: rel-1_421
Changes since 1.23: +1 -1 lines
Log Message:
1.421

File Contents

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