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.14 by root, Sat Jul 19 01:17:12 2008 UTC

1package Devel::FindRef; 1package Devel::FindRef;
2 2
3use strict; 3use strict;
4 4
5use XSLoader; 5use XSLoader;
6 6use Scalar::Util;
7 7
8BEGIN { 8BEGIN {
9 our $VERSION = '0.1'; 9 our $VERSION = '1.3';
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=head1 DESCRIPTION 21=head1 DESCRIPTION
22 22
23Tracking down reference problems (e.g. you expect some object to be 23Tracking down reference problems (e.g. you expect some object to be
24destroyed, but there are still references to it that keep it alive). can 24destroyed, but there are still references to it that keep it alive) can be
25be very hard, although perl keeps track of all values. 25very hard. Fortunately, perl keeps track of all its values, so tracking
26references "backwards" is usually possible.
26 27
27The C<track> function can hlep track down some of those refernces back to 28The C<track> function can help track down some of those references back to
28the variables containing them. 29the variables containing them.
29 30
30For example, for this fragment: 31For example, for this fragment:
31 32
32 package Test; 33 package Test;
… …
41 print Devel::FindRef::track \$var; 42 print Devel::FindRef::track \$var;
42 } 43 }
43 44
44 testsub; 45 testsub;
45 46
46The output is as follows (or similar to htis, in case I forget to update 47The output is as follows (or similar to this, in case I forget to update
47the manpage afetr some changes): 48the manpage after some changes):
48 49
49 SCALAR(0x676fa0) is 50 SCALAR(0x814ece8) is
51 +- in the global $Test::var.
50 referenced by REF(0x676fb0), which is 52 +- referenced by REF(0x814f9e4), which is
51 in the lexical '$x' in CODE(0x676370), which is 53 | in the lexical '$x' in CODE(0x814ed78), which is
52 not found anywhere I looked :( 54 | the containing scope for CODE(0x820c4b0), which is
55 | in the global &Test::testsub.
53 referenced by REF(0x676360), which is 56 +- referenced by REF(0x814ed6c), which is
54 in the member 'ukukey' of HASH(0x756660), which is 57 | in the member 'ukukey' of HASH(0x81da20c), which is
55 in the global %Test::hash. 58 | in the global %Test::hash.
56 in the global $Test::var.
57 referenced by REF(0x6760e0), which is 59 +- referenced by REF(0x814ec28), which is
60 | not found anywhere I looked :(
61 +- referenced by REF(0x814eb44), which is
58 in the member 'ukukey2' of HASH(0x676f30), which is 62 in the member 'ukukey2' of HASH(0x814f99c), which is
59 referenced by REF(0x77bcf0), which is 63 +- referenced by REF(0x820c450), which is
60 in the lexical '$local' in CODE(0x77bcb0), which is 64 | in the lexical '$local' in CODE(0x820c4b0), which was seen before.
61 in the global &Test::testsub.
62 referenced by REF(0x77bc80), which is 65 +- referenced by REF(0x820c204), which is
63 in the global $Test::hash2. 66 in the global $Test::hash2.
64 67
65
66It is a bit convoluted to read, but basically it says that the value stored in C<$var> 68It is a bit convoluted to read, but basically it says that the value
67can be found: 69stored in C<$var> can be found:
68 70
69=over 4 71=over 4
70 72
71=item - in some variable C<$x> whose origin is not known (I frankly have no 73=item - in some variable C<$x> whose origin is not known (I frankly have no
72idea why, hints accepted). 74idea why, hints accepted).
… …
77 79
78=item - in the hash element C<ukukey2>, in the hash in the my variable 80=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 81C<$local> in the sub C<Test::testsub> and also in the hash referenced by
80C<$Test::hash2>. 82C<$Test::hash2>.
81 83
84=back
85
82=head1 EXPORTS 86=head1 EXPORTS
83 87
84None. 88None.
85 89
86=head1 FUNCTIONS 90=head1 FUNCTIONS
… …
98=cut 102=cut
99 103
100sub find($); 104sub find($);
101 105
102sub track { 106sub track {
107 my ($ref, $depth) = @_;
108 @_ = ();
109
103 my $buf = ""; 110 my $buf = "";
111 my %seen;
112
113 Scalar::Util::weaken $ref;
104 114
105 my $track; $track = sub { 115 my $track; $track = sub {
106 my (undef, $depth, $indent) = @_; 116 my ($refref, $depth, $indent) = @_;
107 117
108 if ($depth) { 118 if ($depth) {
109 my (@about) = find $_[0]; 119 my (@about) = find $$refref;
110 if (@about) { 120 if (@about) {
111 for my $about (@about) { 121 for my $about (@about) {
112 $buf .= (" ") x $indent; 122 $buf .= "$indent" . (@about > 1 ? "+- " : " ") . $about->[0];
113 $buf .= $about->[0];
114 if (@$about > 1) { 123 if (@$about > 1) {
124 if ($seen{ref2ptr $about->[1]}++) {
125 $buf .= " $about->[1], which was seen before.\n";
126 } else {
115 $buf .= " $about->[1], which is\n"; 127 $buf .= " $about->[1], which is\n";
116 $track->($about->[1], $depth - 1, $indent + 1); 128 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
129 }
117 } else { 130 } else {
118 $buf .= ".\n"; 131 $buf .= ".\n";
119 } 132 }
120 } 133 }
121 } else { 134 } else {
122 $buf .= (" ") x $indent;
123 $buf .= "not found anywhere I looked :(\n"; 135 $buf .= "$indent not found anywhere I looked :(\n";
124 } 136 }
125 } else { 137 } else {
126 $buf .= (" ") x $indent;
127 $buf .= "not referenced within the search depth.\n"; 138 $buf .= "$indent not referenced within the search depth.\n";
128 } 139 }
129 }; 140 };
130 141
131 $buf .= "$_[0] is\n"; 142 $buf .= "$ref is\n";
132 $track->($_[0], $_[1] || 10, 1); 143 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
133 $buf 144 $buf
134} 145}
135 146
136=item @references = Devel::FindRef::find $ref 147=item @references = Devel::FindRef::find $ref
137 148
138Return arrayrefs that contain [$message, $ref] pairs. The message 149Return arrayrefs that contain [$message, $ref] pairs. The message
139describes what kind of reference was found and the C<$ref> is the 150describes 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 151reference itself, which can be omitted if C<find> decided to end the
141search. 152search. The returned references are all weak references.
142 153
143The C<track> function uses this to find references to the value you are 154The C<track> function uses this to find references to the value you are
144interested in and recurses on the returned references. 155interested in and recurses on the returned references.
145 156
146=cut 157=cut
147 158
148sub find($) { 159sub find($) {
149 my ($about, $excl) = &find_; 160 my ($about, $excl) = &find_;
150 my %excl = map +($_ => 1), @$excl; 161 my %excl = map +($_ => undef), @$excl;
151 grep !$excl{$_->[1] + 0}, @$about 162 grep !exists $excl{ref2ptr $_->[1]}, @$about
152} 163}
153 164
154=item $ref = Devel::FindRef::ref2ptr $ptr 165=item $ref = Devel::FindRef::ptr2ref $integer
155 166
156Sometimes you know (from debugging output) the address of a perl scalar 167Sometimes 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 168you 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, 169to turn the address into a reference to that scalar. It is quite safe to
159but extremely dangerous to call on invalid ones. 170call on valid addresses, but extremely dangerous to call on invalid ones.
171
172 # we know that HASH(0x176ff70) exists, so turn it into a hashref:
173 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
174
175=item $ref = Devel::FindRef::ref2ptr $reference
176
177The opposite of C<ptr2ref>, above: returns the internal address of the
178value pointed to by the passed reference. I<No checks whatsoever will be
179done>, so don't use this.
160 180
161=back 181=back
162 182
183=head1 ENVIRONMENT VARIABLES
184
185You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
186integer to override the default depth in C<track>. If a call explicitly
187specified a depth it is not overridden.
188
163=head1 AUTHOR 189=head1 AUTHOR
164 190
165Marc Lehmann <pcg@goof.com>. 191Marc Lehmann <pcg@goof.com>.
166 192
167=head1 BUGS 193=head1 BUGS
168 194
169Only code values, arrays, hashes, scalars and magic are being looked at. 195Only code values, arrays, hashes, scalars and magic are being looked at.
196
197This is a quick hack only.
170 198
171=head1 COPYRIGHT AND LICENSE 199=head1 COPYRIGHT AND LICENSE
172 200
173Copyright (C) 2007 by Marc Lehmann. 201Copyright (C) 2007 by Marc Lehmann.
174 202

Diff Legend

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