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

Diff Legend

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