File Coverage

blib/lib/Devel/FindRef.pm
Criterion Covered Total %
statement 39 41 95.1
branch 11 12 91.6
condition 4 5 80.0
subroutine 8 8 100.0
pod 2 2 100.0
total 64 68 94.1


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