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.1 by root, Thu Jan 11 22:30:34 2007 UTC vs.
Revision 1.33 by root, Fri Jun 23 14:42:13 2017 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.45;
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 my $closure = sub {
51 my $closure_var = \$_[0];
52 Scalar::Util::weaken (my $weak_ref = \$var);
53 testsub;
54 };
55
56 $closure->($var);
57
46The output is as follows (or similar to htis, in case I forget to update 58The output is as follows (or similar to this, in case I forget to update
47the manpage afetr some changes): 59the manpage after some changes):
48 60
49 SCALAR(0x676fa0) is 61 SCALAR(0x7cc888) [refcount 6] is
50 referenced by REF(0x676fb0), which is 62 +- referenced by REF(0x8abcc8) [refcount 1], which is
51 in the lexical '$x' in CODE(0x676370), which is 63 | the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
52 not found anywhere I looked :( 64 | +- the closure created at tst:18.
53 referenced by REF(0x676360), which is 65 | +- referenced by REF(0x7d3c58) [refcount 1], which is
54 in the member 'ukukey' of HASH(0x756660), which is 66 | | the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
55 in the global %Test::hash. 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.
56 in the global $Test::var. 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.
57 referenced by REF(0x6760e0), which is 83 +- referenced by REF(0x7ae2f0) [refcount 1], which is
58 in the member 'ukukey2' of HASH(0x676f30), which is 84 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 85
65
66It is a bit convoluted to read, but basically it says that the value stored in C<$var> 86It is a bit convoluted to read, but basically it says that the value
67can be found: 87stored in C<$var> is referenced by:
68 88
69=over 4 89=over 4
70 90
71=item - in some variable C<$x> whose origin is not known (I frankly have no 91=item - the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
72idea why, hints accepted). 92closure, which in turn is used quite a bit.
73 93
74=item - in the hash element with key C<ukukey> in the hash stored in C<%Test::hash>. 94=item - the package-level lexical C<$global_my>.
75 95
76=item - in the global variable named C<$Test::var>. 96=item - the global package variable named C<$Test::var>.
77 97
78=item - in the hash element C<ukukey2>, in the hash in the my variable 98=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 99C<$testsub_local> in the sub C<Test::testsub> and also in the hash
100C<$referenced by Test::hash2>.
101
102=item - the hash element with key C<ukukey> in the hash stored in
80C<$Test::hash2>. 103C<%Test::hash>.
104
105=item - some anonymous mortalised reference on the stack (which is caused
106by calling C<track> with the expression C<\$var>, which creates the
107reference).
108
109=back
110
111And all these account for six reference counts.
81 112
82=head1 EXPORTS 113=head1 EXPORTS
83 114
84None. 115None.
85 116
91 122
92Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and 123Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and
93return a descriptive string. C<$ref> can point at any perl value, be it 124return a descriptive string. C<$ref> can point at any perl value, be it
94anonymous sub, hash, array, scalar etc. 125anonymous sub, hash, array, scalar etc.
95 126
96This is the function you most often use. 127This is the function you most likely want to use when tracking down
128references.
97 129
98=cut 130=cut
99 131
100sub find($); 132sub find($);
101 133
134sub _f($) {
135 "$_[0] [refcount " . (_refcnt $_[0]) . "]"
136}
137
102sub track { 138sub track {
139 my ($ref, $depth) = @_;
140 @_ = ();
141
103 my $buf = ""; 142 my $buf = "";
143 my %seen;
144
145 Scalar::Util::weaken $ref;
104 146
105 my $track; $track = sub { 147 my $track; $track = sub {
106 my (undef, $depth, $indent) = @_; 148 my ($refref, $depth, $indent) = @_;
107 149
108 if ($depth) { 150 if ($depth) {
109 my (@about) = find $_[0]; 151 my (@about) = find $$refref;
110 if (@about) { 152 if (@about) {
111 for my $about (@about) { 153 for my $about (@about) {
112 $buf .= (" ") x $indent; 154 $about->[0] =~ s/([^\x20-\x7e])/sprintf "\\{%02x}", ord $1/ge;
113 $buf .= $about->[0]; 155 $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
114 if (@$about > 1) { 156 if (@$about > 1) {
157 if ($seen{ref2ptr $about->[1]}++) {
158 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
159 } else {
115 $buf .= " $about->[1], which is\n"; 160 $buf .= " " . (_f $about->[1]) . ", which is\n";
116 $track->($about->[1], $depth - 1, $indent + 1); 161 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
162 }
117 } else { 163 } else {
118 $buf .= ".\n"; 164 $buf .= ".\n";
119 } 165 }
120 } 166 }
121 } else { 167 } else {
122 $buf .= (" ") x $indent;
123 $buf .= "not found anywhere I looked :(\n"; 168 $buf .= "$indent not found anywhere I looked :(\n";
124 } 169 }
125 } else { 170 } else {
126 $buf .= (" ") x $indent;
127 $buf .= "not referenced within the search depth.\n"; 171 $buf .= "$indent not referenced within the search depth.\n";
128 } 172 }
129 }; 173 };
130 174
131 $buf .= "$_[0] is\n"; 175 $buf .= (_f $ref) . " is\n";
132 $track->($_[0], $_[1] || 10, 1); 176
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 value you
157you are interested in. This function can be used to turn the address into 202are interested in (e.g. C<HASH(0x176ff70)>). This function can be used to
158a reference to that scalar. It is quite safe to call on valid addresses, 203turn the address into a reference to that value. It is quite safe to call
159but extremely dangerous to call on invalid ones. 204on valid addresses, but extremely dangerous to call on invalid ones. I<No
205checks whatsoever will be done>, so don't use this unless you really know
206the 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
213The opposite of C<ptr2ref>, above: returns the internal address of the
214value pointed to by the passed reference. This function is safe to call on
215anything, and returns the same value that a normal reference would if used
216in a numeric context.
160 217
161=back 218=back
162 219
220=head1 ENVIRONMENT VARIABLES
221
222You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
223integer to override the default depth in C<track>. If a call explicitly
224specifies a depth, it is not overridden.
225
163=head1 AUTHOR 226=head1 AUTHOR
164 227
165Marc Lehmann <pcg@goof.com>. 228Marc Lehmann <pcg@goof.com>.
166 229
167=head1 BUGS
168
169Only code values, arrays, hashes and scalars are being looked at. Tied
170values and magic is not currently being investigated.
171
172=head1 COPYRIGHT AND LICENSE 230=head1 COPYRIGHT AND LICENSE
173 231
174Copyright (C) 2007 by Marc Lehmann. 232Copyright (C) 2007, 2008, 2009, 2013 by Marc Lehmann.
175 233
176This library is free software; you can redistribute it and/or modify 234This library is free software; you can redistribute it and/or modify
177it under the same terms as Perl itself, either Perl version 5.8.8 or, 235it under the same terms as Perl itself, either Perl version 5.8.8 or,
178at your option, any later version of Perl 5 you may have available. 236at your option, any later version of Perl 5 you may have available.
179 237

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines