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.2 by root, Thu Jan 11 23:08:03 2007 UTC vs.
Revision 1.19 by root, Mon Dec 1 13:47:09 2008 UTC

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

Diff Legend

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