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.14 by root, Sat Jul 19 01:17:12 2008 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;
6use Scalar::Util; 6use Scalar::Util;
7 7
8BEGIN { 8BEGIN {
9 our $VERSION = '1.3'; 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 variable 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(0x814ece8) is 62 SCALAR(0x7cc888) [refcount 6] is
63 +- referenced by REF(0x8abcc8) [refcount 1], which is
64 | the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
65 | +- the closure created at tst:18.
66 | +- referenced by REF(0x7d3c58) [refcount 1], which is
67 | | the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
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.
51 +- in the global $Test::var. 74 +- the global $Test::var.
52 +- referenced by REF(0x814f9e4), which is 75 +- referenced by REF(0x7cc558) [refcount 1], which is
53 | in the lexical '$x' in CODE(0x814ed78), which is 76 | the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is
54 | the containing scope for CODE(0x820c4b0), which is 77 | +- referenced by REF(0x8abad0) [refcount 1], which is
55 | in the global &Test::testsub. 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.
56 +- referenced by REF(0x814ed6c), which is 81 +- referenced by REF(0x7ae518) [refcount 1], which is
57 | in the member 'ukukey' of HASH(0x81da20c), which is 82 | the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is
58 | in the global %Test::hash. 83 | the global %Test::global_hash.
59 +- referenced by REF(0x814ec28), which is 84 +- referenced by REF(0x7ae2f0) [refcount 1], which is
60 | not found anywhere I looked :( 85 a temporary on the stack.
61 +- referenced by REF(0x814eb44), which is
62 in the member 'ukukey2' of HASH(0x814f99c), which is
63 +- referenced by REF(0x820c450), which is
64 | in the lexical '$local' in CODE(0x820c4b0), which was seen before.
65 +- referenced by REF(0x820c204), which is
66 in the global $Test::hash2.
67 86
68It 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
69stored in C<$var> can be found: 88stored in C<$var> is referenced by:
70 89
71=over 4 90=over 4
72 91
73=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
74idea why, hints accepted). 93closure, which in turn is used quite a bit.
75 94
76=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>.
77 96
78=item - in the global variable named C<$Test::var>. 97=item - the global package variable named C<$Test::var>.
79 98
80=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
81C<$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
82C<$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).
83 109
84=back 110=back
111
112And all these account for six reference counts.
113
85 114
86=head1 EXPORTS 115=head1 EXPORTS
87 116
88None. 117None.
89 118
… …
100This is the function you most often use. 129This is the function you most often use.
101 130
102=cut 131=cut
103 132
104sub find($); 133sub find($);
134
135sub _f($) {
136 "$_[0] [refcount " . (_refcnt $_[0]) . "]"
137}
105 138
106sub track { 139sub track {
107 my ($ref, $depth) = @_; 140 my ($ref, $depth) = @_;
108 @_ = (); 141 @_ = ();
109 142
… …
117 150
118 if ($depth) { 151 if ($depth) {
119 my (@about) = find $$refref; 152 my (@about) = find $$refref;
120 if (@about) { 153 if (@about) {
121 for my $about (@about) { 154 for my $about (@about) {
155 $about->[0] =~ s/([^\x20-\x7e])/sprintf "\\{%02x}", ord $1/ge;
122 $buf .= "$indent" . (@about > 1 ? "+- " : " ") . $about->[0]; 156 $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
123 if (@$about > 1) { 157 if (@$about > 1) {
124 if ($seen{ref2ptr $about->[1]}++) { 158 if ($seen{ref2ptr $about->[1]}++) {
125 $buf .= " $about->[1], which was seen before.\n"; 159 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
126 } else { 160 } else {
127 $buf .= " $about->[1], which is\n"; 161 $buf .= " " . (_f $about->[1]) . ", which is\n";
128 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| "); 162 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
129 } 163 }
130 } else { 164 } else {
131 $buf .= ".\n"; 165 $buf .= ".\n";
132 } 166 }
… …
137 } else { 171 } else {
138 $buf .= "$indent not referenced within the search depth.\n"; 172 $buf .= "$indent not referenced within the search depth.\n";
139 } 173 }
140 }; 174 };
141 175
142 $buf .= "$ref is\n"; 176 $buf .= (_f $ref) . " is\n";
177
143 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, ""); 178 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
144 $buf 179 $buf
145} 180}
146 181
147=item @references = Devel::FindRef::find $ref 182=item @references = Devel::FindRef::find $ref
… …
157=cut 192=cut
158 193
159sub find($) { 194sub find($) {
160 my ($about, $excl) = &find_; 195 my ($about, $excl) = &find_;
161 my %excl = map +($_ => undef), @$excl; 196 my %excl = map +($_ => undef), @$excl;
162 grep !exists $excl{ref2ptr $_->[1]}, @$about 197 grep !($#$_ && exists $excl{ref2ptr $_->[1]}), @$about
163} 198}
164 199
165=item $ref = Devel::FindRef::ptr2ref $integer 200=item $ref = Devel::FindRef::ptr2ref $integer
166 201
167Sometimes you know (from debugging output) the address of a perl scalar 202Sometimes you know (from debugging output) the address of a perl scalar
… …
188 223
189=head1 AUTHOR 224=head1 AUTHOR
190 225
191Marc Lehmann <pcg@goof.com>. 226Marc Lehmann <pcg@goof.com>.
192 227
193=head1 BUGS
194
195Only code values, arrays, hashes, scalars and magic are being looked at.
196
197This is a quick hack only.
198
199=head1 COPYRIGHT AND LICENSE 228=head1 COPYRIGHT AND LICENSE
200 229
201Copyright (C) 2007 by Marc Lehmann. 230Copyright (C) 2007, 2008 by Marc Lehmann.
202 231
203This library is free software; you can redistribute it and/or modify 232This library is free software; you can redistribute it and/or modify
204it 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,
205at 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.
206 235

Diff Legend

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