ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.pm
Revision: 1.18
Committed: Mon Dec 1 13:22:43 2008 UTC (15 years, 6 months ago) by root
Branch: MAIN
Changes since 1.17: +7 -3 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 package Devel::FindRef;
2
3 no warnings; # I hate warning nazis
4 use strict;
5
6 use XSLoader;
7 use Scalar::Util;
8
9 BEGIN {
10 our $VERSION = '1.31';
11 XSLoader::load __PACKAGE__, $VERSION;
12 }
13
14 =head1 NAME
15
16 Devel::FindRef - where is that reference to my variable hiding?
17
18 =head1 SYNOPSIS
19
20 use Devel::FindRef;
21
22 print Devel::FindRef::track \$some_variable;
23
24 =head1 DESCRIPTION
25
26 Tracking down reference problems (e.g. you expect some object to be
27 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
31 The C<track> function can help track down some of those references back to
32 the variables containing them.
33
34 For example, for this fragment:
35
36 package Test;
37
38 our $var = "hi\n";
39 my $x = \$var;
40 our %hash = (ukukey => \$var);
41 our $hash2 = {ukukey2 => \$var};
42
43 sub testsub {
44 my $local = $hash2;
45 print Devel::FindRef::track \$var;
46 }
47
48 testsub;
49
50 The output is as follows (or similar to this, in case I forget to update
51 the manpage after some changes):
52
53 SCALAR(0x814ece8) is
54 +- in the global $Test::var.
55 +- referenced by REF(0x814f9e4), which is
56 | in the lexical '$x' in CODE(0x814ed78), which is
57 | the containing scope for CODE(0x820c4b0), which is
58 | in the global &Test::testsub.
59 +- referenced by REF(0x814ed6c), which is
60 | in the member 'ukukey' of HASH(0x81da20c), which is
61 | in the global %Test::hash.
62 +- referenced by REF(0x814ec28), which is
63 | not found anywhere I looked :(
64 +- referenced by REF(0x814eb44), which is
65 in the member 'ukukey2' of HASH(0x814f99c), which is
66 +- referenced by REF(0x820c450), which is
67 | in the lexical '$local' in CODE(0x820c4b0), which was seen before.
68 +- referenced by REF(0x820c204), which is
69 in the global $Test::hash2.
70
71 It is a bit convoluted to read, but basically it says that the value
72 stored in C<$var> can be found:
73
74 =over 4
75
76 =item - in some variable C<$x> whose origin is not known (I frankly have no
77 idea why, hints accepted).
78
79 =item - in the hash element with key C<ukukey> in the hash stored in C<%Test::hash>.
80
81 =item - in the global variable named C<$Test::var>.
82
83 =item - in the hash element C<ukukey2>, in the hash in the my variable
84 C<$local> in the sub C<Test::testsub> and also in the hash referenced by
85 C<$Test::hash2>.
86
87 =back
88
89 =head1 EXPORTS
90
91 None.
92
93 =head1 FUNCTIONS
94
95 =over 4
96
97 =item $string = Devel::FindRef::track $ref[, $depth]
98
99 Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and
100 return a descriptive string. C<$ref> can point at any perl value, be it
101 anonymous sub, hash, array, scalar etc.
102
103 This is the function you most often use.
104
105 =cut
106
107 sub find($);
108
109 sub _f($) {
110 "$_[0] [refcount " . (_refcnt $_[0]) . "]"
111 }
112
113 sub track {
114 my ($ref, $depth) = @_;
115 @_ = ();
116
117 my $buf = "";
118 my %seen;
119
120 Scalar::Util::weaken $ref;
121
122 my $track; $track = sub {
123 my ($refref, $depth, $indent) = @_;
124
125 if ($depth) {
126 my (@about) = find $$refref;
127 if (@about) {
128 for my $about (@about) {
129 $buf .= "$indent" . (@about > 1 ? "+- " : " ") . $about->[0];
130 if (@$about > 1) {
131 if ($seen{ref2ptr $about->[1]}++) {
132 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
133 } else {
134 $buf .= " " . (_f $about->[1]) . ", which is\n";
135 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
136 }
137 } else {
138 $buf .= ".\n";
139 }
140 }
141 } else {
142 $buf .= "$indent not found anywhere I looked :(\n";
143 }
144 } else {
145 $buf .= "$indent not referenced within the search depth.\n";
146 }
147 };
148
149 $buf .= (_f $ref) . " is\n";
150 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
151 $buf
152 }
153
154 =item @references = Devel::FindRef::find $ref
155
156 Return arrayrefs that contain [$message, $ref] pairs. The message
157 describes what kind of reference was found and the C<$ref> is the
158 reference itself, which can be omitted if C<find> decided to end the
159 search. The returned references are all weak references.
160
161 The C<track> function uses this to find references to the value you are
162 interested in and recurses on the returned references.
163
164 =cut
165
166 sub find($) {
167 my ($about, $excl) = &find_;
168 my %excl = map +($_ => undef), @$excl;
169 grep !exists $excl{ref2ptr $_->[1]}, @$about
170 }
171
172 =item $ref = Devel::FindRef::ptr2ref $integer
173
174 Sometimes you know (from debugging output) the address of a perl scalar
175 you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used
176 to turn the address into a reference to that scalar. It is quite safe to
177 call on valid addresses, but extremely dangerous to call on invalid ones.
178
179 # we know that HASH(0x176ff70) exists, so turn it into a hashref:
180 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
181
182 =item $ref = Devel::FindRef::ref2ptr $reference
183
184 The opposite of C<ptr2ref>, above: returns the internal address of the
185 value pointed to by the passed reference. I<No checks whatsoever will be
186 done>, so don't use this.
187
188 =back
189
190 =head1 ENVIRONMENT VARIABLES
191
192 You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
193 integer to override the default depth in C<track>. If a call explicitly
194 specified a depth it is not overridden.
195
196 =head1 AUTHOR
197
198 Marc Lehmann <pcg@goof.com>.
199
200 =head1 COPYRIGHT AND LICENSE
201
202 Copyright (C) 2007, 2008 by Marc Lehmann.
203
204 This library is free software; you can redistribute it and/or modify
205 it under the same terms as Perl itself, either Perl version 5.8.8 or,
206 at your option, any later version of Perl 5 you may have available.
207
208 =cut
209
210 1
211