ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.pm
Revision: 1.19
Committed: Mon Dec 1 13:47:09 2008 UTC (15 years, 5 months ago) by root
Branch: MAIN
CVS Tags: rel-1_4
Changes since 1.18: +58 -31 lines
Log Message:
1.4

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.19 our $VERSION = '1.4';
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.19 =item - in the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
94     closure, which in turn is used quite a bit.
95 root 1.1
96 root 1.19 =item - in the package-level lexical C<$global_my>.
97 root 1.1
98 root 1.19 =item - in the global package variable named C<$Test::var>.
99 root 1.1
100     =item - in 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     =item - in the hash element with key C<ukukey> in the hash stored in
105     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.19 $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
157 root 1.1 if (@$about > 1) {
158 root 1.14 if ($seen{ref2ptr $about->[1]}++) {
159 root 1.18 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
160 root 1.11 } else {
161 root 1.18 $buf .= " " . (_f $about->[1]) . ", which is\n";
162 root 1.12 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
163 root 1.11 }
164 root 1.1 } else {
165     $buf .= ".\n";
166     }
167     }
168     } else {
169 root 1.12 $buf .= "$indent not found anywhere I looked :(\n";
170 root 1.1 }
171     } else {
172 root 1.12 $buf .= "$indent not referenced within the search depth.\n";
173 root 1.1 }
174     };
175    
176 root 1.18 $buf .= (_f $ref) . " is\n";
177 root 1.12 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
178 root 1.1 $buf
179     }
180    
181     =item @references = Devel::FindRef::find $ref
182    
183     Return arrayrefs that contain [$message, $ref] pairs. The message
184     describes what kind of reference was found and the C<$ref> is the
185 root 1.9 reference itself, which can be omitted if C<find> decided to end the
186     search. The returned references are all weak references.
187 root 1.1
188     The C<track> function uses this to find references to the value you are
189     interested in and recurses on the returned references.
190    
191     =cut
192    
193     sub find($) {
194     my ($about, $excl) = &find_;
195 root 1.6 my %excl = map +($_ => undef), @$excl;
196 root 1.14 grep !exists $excl{ref2ptr $_->[1]}, @$about
197 root 1.1 }
198    
199 root 1.7 =item $ref = Devel::FindRef::ptr2ref $integer
200 root 1.1
201     Sometimes you know (from debugging output) the address of a perl scalar
202 root 1.7 you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used
203     to turn the address into a reference to that scalar. It is quite safe to
204     call on valid addresses, but extremely dangerous to call on invalid ones.
205    
206     # we know that HASH(0x176ff70) exists, so turn it into a hashref:
207     my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
208 root 1.1
209 root 1.14 =item $ref = Devel::FindRef::ref2ptr $reference
210    
211     The opposite of C<ptr2ref>, above: returns the internal address of the
212     value pointed to by the passed reference. I<No checks whatsoever will be
213     done>, so don't use this.
214    
215 root 1.1 =back
216    
217 root 1.12 =head1 ENVIRONMENT VARIABLES
218    
219     You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
220     integer to override the default depth in C<track>. If a call explicitly
221     specified a depth it is not overridden.
222    
223 root 1.1 =head1 AUTHOR
224    
225     Marc Lehmann <pcg@goof.com>.
226    
227     =head1 COPYRIGHT AND LICENSE
228    
229 root 1.17 Copyright (C) 2007, 2008 by Marc Lehmann.
230 root 1.1
231     This library is free software; you can redistribute it and/or modify
232     it under the same terms as Perl itself, either Perl version 5.8.8 or,
233     at your option, any later version of Perl 5 you may have available.
234    
235     =cut
236    
237     1
238