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.7 by root, Mon Apr 30 21:08:14 2007 UTC vs.
Revision 1.28 by root, Sat Apr 13 06:29:39 2013 UTC

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

Diff Legend

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