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.15 by root, Sat Jul 19 01:38:57 2008 UTC vs.
Revision 1.19 by root, Mon Dec 1 13:47:09 2008 UTC

5 5
6use XSLoader; 6use XSLoader;
7use Scalar::Util; 7use Scalar::Util;
8 8
9BEGIN { 9BEGIN {
10 our $VERSION = '1.31'; 10 our $VERSION = '1.4';
11 XSLoader::load __PACKAGE__, $VERSION; 11 XSLoader::load __PACKAGE__, $VERSION;
12} 12}
13 13
14=head1 NAME 14=head1 NAME
15 15
16Devel::FindRef - where is that reference to my variable hiding? 16Devel::FindRef - where is that reference to my variable hiding?
17 17
18=head1 SYNOPSIS 18=head1 SYNOPSIS
19 19
20 use Devel::FindRef; 20 use Devel::FindRef;
21
22 print Devel::FindRef::track \$some_variable;
21 23
22=head1 DESCRIPTION 24=head1 DESCRIPTION
23 25
24Tracking down reference problems (e.g. you expect some object to be 26Tracking down reference problems (e.g. you expect some object to be
25destroyed, but there are still references to it that keep it alive) can be 27destroyed, but there are still references to it that keep it alive) can be
30the variables containing them. 32the variables containing them.
31 33
32For example, for this fragment: 34For example, for this fragment:
33 35
34 package Test; 36 package Test;
37
38 use Devel::FindRef;
39 use Scalar::Util;
35 40
36 our $var = "hi\n"; 41 our $var = "hi\n";
37 my $x = \$var; 42 my $global_my = \$var;
38 our %hash = (ukukey => \$var); 43 our %global_hash = (ukukey => \$var);
39 our $hash2 = {ukukey2 => \$var}; 44 our $global_hashref = { ukukey2 => \$var };
40 45
41 sub testsub { 46 sub testsub {
42 my $local = $hash2; 47 my $testsub_local = $global_hashref;
43 print Devel::FindRef::track \$var; 48 print Devel::FindRef::track \$var;
44 } 49 }
45 50
46 testsub; 51
52 my $closure = sub {
53 my $closure_var = \$_[0];
54 Scalar::Util::weaken (my $weak_ref = \$var);
55 testsub;
56 };
57
58 $closure->($var);
47 59
48The output is as follows (or similar to this, in case I forget to update 60The output is as follows (or similar to this, in case I forget to update
49the manpage after some changes): 61the manpage after some changes):
50 62
51 SCALAR(0x814ece8) is 63 SCALAR(0x7cc888) [refcount 6] is
64 +- referenced by REF(0x8abcc8) [refcount 1], which is
65 | in the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
66 | +- the closure created at tst:18.
67 | +- referenced by REF(0x7d3c58) [refcount 1], which is
68 | | in the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
69 | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is
70 | | | in the global &Test::testsub.
71 | | +- the main body of the program.
72 | +- in the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before.
73 +- referenced by REF(0x7cc7c8) [refcount 1], which is
74 | in the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before.
52 +- in the global $Test::var. 75 +- in the global $Test::var.
53 +- referenced by REF(0x814f9e4), which is 76 +- referenced by REF(0x7cc558) [refcount 1], which is
54 | in the lexical '$x' in CODE(0x814ed78), which is
55 | the containing scope for CODE(0x820c4b0), which is
56 | in the global &Test::testsub.
57 +- referenced by REF(0x814ed6c), which is
58 | in the member 'ukukey' of HASH(0x81da20c), which is 77 | in the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is
78 | +- referenced by REF(0x8abad0) [refcount 1], which is
79 | | in the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before.
80 | +- referenced by REF(0x8ab4f0) [refcount 1], which is
81 | in the global $Test::global_hashref.
82 +- referenced by REF(0x7ae518) [refcount 1], which is
83 | in the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is
59 | in the global %Test::hash. 84 | in the global %Test::global_hash.
60 +- referenced by REF(0x814ec28), which is 85 +- referenced by REF(0x7ae2f0) [refcount 1], which is
61 | not found anywhere I looked :( 86 a temporary on the stack.
62 +- referenced by REF(0x814eb44), which is
63 in the member 'ukukey2' of HASH(0x814f99c), which is
64 +- referenced by REF(0x820c450), which is
65 | in the lexical '$local' in CODE(0x820c4b0), which was seen before.
66 +- referenced by REF(0x820c204), which is
67 in the global $Test::hash2.
68 87
69It is a bit convoluted to read, but basically it says that the value 88It is a bit convoluted to read, but basically it says that the value
70stored in C<$var> can be found: 89stored in C<$var> is referenced by:
71 90
72=over 4 91=over 4
73 92
74=item - in some variable C<$x> whose origin is not known (I frankly have no 93=item - in the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
75idea why, hints accepted). 94closure, which in turn is used quite a bit.
76 95
77=item - in the hash element with key C<ukukey> in the hash stored in C<%Test::hash>. 96=item - in the package-level lexical C<$global_my>.
78 97
79=item - in the global variable named C<$Test::var>. 98=item - in the global package variable named C<$Test::var>.
80 99
81=item - in the hash element C<ukukey2>, in the hash in the my variable 100=item - in the hash element C<ukukey2>, in the hash in the my variable
82C<$local> in the sub C<Test::testsub> and also in the hash referenced by 101C<$testsub_local> in the sub C<Test::testsub> and also in the hash
102C<$referenced by Test::hash2>.
103
104=item - in the hash element with key C<ukukey> in the hash stored in
83C<$Test::hash2>. 105C<%Test::hash>.
106
107=item - some anonymous mortalised reference on the stack (which is caused
108by calling C<track> with the expression C<\$var>, which creates the
109reference).
84 110
85=back 111=back
112
113And all these account for six reference counts.
114
86 115
87=head1 EXPORTS 116=head1 EXPORTS
88 117
89None. 118None.
90 119
101This is the function you most often use. 130This is the function you most often use.
102 131
103=cut 132=cut
104 133
105sub find($); 134sub find($);
135
136sub _f($) {
137 "$_[0] [refcount " . (_refcnt $_[0]) . "]"
138}
106 139
107sub track { 140sub track {
108 my ($ref, $depth) = @_; 141 my ($ref, $depth) = @_;
109 @_ = (); 142 @_ = ();
110 143
118 151
119 if ($depth) { 152 if ($depth) {
120 my (@about) = find $$refref; 153 my (@about) = find $$refref;
121 if (@about) { 154 if (@about) {
122 for my $about (@about) { 155 for my $about (@about) {
123 $buf .= "$indent" . (@about > 1 ? "+- " : " ") . $about->[0]; 156 $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
124 if (@$about > 1) { 157 if (@$about > 1) {
125 if ($seen{ref2ptr $about->[1]}++) { 158 if ($seen{ref2ptr $about->[1]}++) {
126 $buf .= " $about->[1], which was seen before.\n"; 159 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
127 } else { 160 } else {
128 $buf .= " $about->[1], which is\n"; 161 $buf .= " " . (_f $about->[1]) . ", which is\n";
129 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| "); 162 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
130 } 163 }
131 } else { 164 } else {
132 $buf .= ".\n"; 165 $buf .= ".\n";
133 } 166 }
138 } else { 171 } else {
139 $buf .= "$indent not referenced within the search depth.\n"; 172 $buf .= "$indent not referenced within the search depth.\n";
140 } 173 }
141 }; 174 };
142 175
143 $buf .= "$ref is\n"; 176 $buf .= (_f $ref) . " is\n";
144 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, ""); 177 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
145 $buf 178 $buf
146} 179}
147 180
148=item @references = Devel::FindRef::find $ref 181=item @references = Devel::FindRef::find $ref
189 222
190=head1 AUTHOR 223=head1 AUTHOR
191 224
192Marc Lehmann <pcg@goof.com>. 225Marc Lehmann <pcg@goof.com>.
193 226
194=head1 BUGS
195
196Only code values, arrays, hashes, scalars and magic are being looked at.
197
198This is a quick hack only.
199
200=head1 COPYRIGHT AND LICENSE 227=head1 COPYRIGHT AND LICENSE
201 228
202Copyright (C) 2007 by Marc Lehmann. 229Copyright (C) 2007, 2008 by Marc Lehmann.
203 230
204This library is free software; you can redistribute it and/or modify 231This library is free software; you can redistribute it and/or modify
205it under the same terms as Perl itself, either Perl version 5.8.8 or, 232it under the same terms as Perl itself, either Perl version 5.8.8 or,
206at your option, any later version of Perl 5 you may have available. 233at your option, any later version of Perl 5 you may have available.
207 234

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines