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.19 by root, Mon Dec 1 13:47:09 2008 UTC vs.
Revision 1.31 by root, Sun May 18 18:44:08 2014 UTC

1package Devel::FindRef; 1package Devel::FindRef;
2 2
3no warnings; # I hate warning nazis 3use common::sense;
4use strict;
5 4
6use XSLoader; 5use XSLoader;
7use Scalar::Util; 6use Scalar::Util;
8 7
9BEGIN { 8BEGIN {
10 our $VERSION = '1.4'; 9 our $VERSION = '1.43';
11 XSLoader::load __PACKAGE__, $VERSION; 10 XSLoader::load __PACKAGE__, $VERSION;
12} 11}
13 12
14=head1 NAME 13=head1 NAME
15 14
… …
31The C<track> function can help track down some of those references back to 30The C<track> function can help track down some of those references back to
32the variables containing them. 31the variables containing them.
33 32
34For example, for this fragment: 33For example, for this fragment:
35 34
36 package Test; 35 package Test;
37 36
38 use Devel::FindRef; 37 use Devel::FindRef;
39 use Scalar::Util; 38 use Scalar::Util;
40 39
41 our $var = "hi\n"; 40 our $var = "hi\n";
42 my $global_my = \$var; 41 my $global_my = \$var;
43 our %global_hash = (ukukey => \$var); 42 our %global_hash = (ukukey => \$var);
44 our $global_hashref = { ukukey2 => \$var }; 43 our $global_hashref = { ukukey2 => \$var };
45 44
46 sub testsub { 45 sub testsub {
47 my $testsub_local = $global_hashref; 46 my $testsub_local = $global_hashref;
48 print Devel::FindRef::track \$var; 47 print Devel::FindRef::track \$var;
49 } 48 }
50
51 49
52 my $closure = sub { 50 my $closure = sub {
53 my $closure_var = \$_[0]; 51 my $closure_var = \$_[0];
54 Scalar::Util::weaken (my $weak_ref = \$var); 52 Scalar::Util::weaken (my $weak_ref = \$var);
55 testsub; 53 testsub;
… …
60The output is as follows (or similar to this, in case I forget to update 58The output is as follows (or similar to this, in case I forget to update
61the manpage after some changes): 59the manpage after some changes):
62 60
63 SCALAR(0x7cc888) [refcount 6] is 61 SCALAR(0x7cc888) [refcount 6] is
64 +- referenced by REF(0x8abcc8) [refcount 1], which is 62 +- referenced by REF(0x8abcc8) [refcount 1], which is
65 | in the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is 63 | the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
66 | +- the closure created at tst:18. 64 | +- the closure created at tst:18.
67 | +- referenced by REF(0x7d3c58) [refcount 1], which is 65 | +- referenced by REF(0x7d3c58) [refcount 1], which is
68 | | in the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is 66 | | the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
69 | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is 67 | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is
70 | | | in the global &Test::testsub. 68 | | | the global &Test::testsub.
71 | | +- the main body of the program. 69 | | +- the main body of the program.
72 | +- in the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before. 70 | +- the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before.
73 +- referenced by REF(0x7cc7c8) [refcount 1], which is 71 +- referenced by REF(0x7cc7c8) [refcount 1], which is
74 | in the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before. 72 | the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before.
75 +- in the global $Test::var. 73 +- the global $Test::var.
76 +- referenced by REF(0x7cc558) [refcount 1], which is 74 +- referenced by REF(0x7cc558) [refcount 1], which is
77 | in the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is 75 | the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is
78 | +- referenced by REF(0x8abad0) [refcount 1], which is 76 | +- referenced by REF(0x8abad0) [refcount 1], which is
79 | | in the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before. 77 | | the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before.
80 | +- referenced by REF(0x8ab4f0) [refcount 1], which is 78 | +- referenced by REF(0x8ab4f0) [refcount 1], which is
81 | in the global $Test::global_hashref. 79 | the global $Test::global_hashref.
82 +- referenced by REF(0x7ae518) [refcount 1], which is 80 +- referenced by REF(0x7ae518) [refcount 1], which is
83 | in the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is 81 | the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is
84 | in the global %Test::global_hash. 82 | the global %Test::global_hash.
85 +- referenced by REF(0x7ae2f0) [refcount 1], which is 83 +- referenced by REF(0x7ae2f0) [refcount 1], which is
86 a temporary on the stack. 84 a temporary on the stack.
87 85
88It is a bit convoluted to read, but basically it says that the value 86It is a bit convoluted to read, but basically it says that the value
89stored in C<$var> is referenced by: 87stored in C<$var> is referenced by:
90 88
91=over 4 89=over 4
92 90
93=item - in the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated 91=item - the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
94closure, which in turn is used quite a bit. 92closure, which in turn is used quite a bit.
95 93
96=item - in the package-level lexical C<$global_my>. 94=item - the package-level lexical C<$global_my>.
97 95
98=item - in the global package variable named C<$Test::var>. 96=item - the global package variable named C<$Test::var>.
99 97
100=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
101C<$testsub_local> in the sub C<Test::testsub> and also in the hash 99C<$testsub_local> in the sub C<Test::testsub> and also in the hash
102C<$referenced by Test::hash2>. 100C<$referenced by Test::hash2>.
103 101
104=item - in the hash element with key C<ukukey> in the hash stored in 102=item - the hash element with key C<ukukey> in the hash stored in
105C<%Test::hash>. 103C<%Test::hash>.
106 104
107=item - some anonymous mortalised reference on the stack (which is caused 105=item - some anonymous mortalised reference on the stack (which is caused
108by calling C<track> with the expression C<\$var>, which creates the 106by calling C<track> with the expression C<\$var>, which creates the
109reference). 107reference).
110 108
111=back 109=back
112 110
113And all these account for six reference counts. 111And all these account for six reference counts.
114 112
115
116=head1 EXPORTS 113=head1 EXPORTS
117 114
118None. 115None.
119 116
120=head1 FUNCTIONS 117=head1 FUNCTIONS
… …
125 122
126Track 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
127return 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
128anonymous sub, hash, array, scalar etc. 125anonymous sub, hash, array, scalar etc.
129 126
130This is the function you most often use. 127This is the function you most likely want to use when tracking down
128references.
131 129
132=cut 130=cut
133 131
134sub find($); 132sub find($);
135 133
… …
151 149
152 if ($depth) { 150 if ($depth) {
153 my (@about) = find $$refref; 151 my (@about) = find $$refref;
154 if (@about) { 152 if (@about) {
155 for my $about (@about) { 153 for my $about (@about) {
154 $about->[0] =~ s/([^\x20-\x7e])/sprintf "\\{%02x}", ord $1/ge;
156 $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0]; 155 $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
157 if (@$about > 1) { 156 if (@$about > 1) {
158 if ($seen{ref2ptr $about->[1]}++) { 157 if ($seen{ref2ptr $about->[1]}++) {
159 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n"; 158 $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
160 } else { 159 } else {
… …
172 $buf .= "$indent not referenced within the search depth.\n"; 171 $buf .= "$indent not referenced within the search depth.\n";
173 } 172 }
174 }; 173 };
175 174
176 $buf .= (_f $ref) . " is\n"; 175 $buf .= (_f $ref) . " is\n";
176
177 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, ""); 177 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
178 $buf 178 $buf
179} 179}
180 180
181=item @references = Devel::FindRef::find $ref 181=item @references = Devel::FindRef::find $ref
… …
191=cut 191=cut
192 192
193sub find($) { 193sub find($) {
194 my ($about, $excl) = &find_; 194 my ($about, $excl) = &find_;
195 my %excl = map +($_ => undef), @$excl; 195 my %excl = map +($_ => undef), @$excl;
196 grep !exists $excl{ref2ptr $_->[1]}, @$about 196 grep !($#$_ && exists $excl{ref2ptr $_->[1]}), @$about
197} 197}
198 198
199=item $ref = Devel::FindRef::ptr2ref $integer 199=item $ref = Devel::FindRef::ptr2ref $integer
200 200
201Sometimes you know (from debugging output) the address of a perl scalar 201Sometimes you know (from debugging output) the address of a perl value you
202you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used 202are interested in (e.g. C<HASH(0x176ff70)>). This function can be used to
203to turn the address into a reference to that scalar. It is quite safe to 203turn the address into a reference to that value. It is quite safe to call
204call on valid addresses, but 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.
205 207
206 # we know that HASH(0x176ff70) exists, so turn it into a hashref: 208 # we know that HASH(0x176ff70) exists, so turn it into a hashref:
207 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70; 209 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
208 210
209=item $ref = Devel::FindRef::ref2ptr $reference 211=item $ptr = Devel::FindRef::ref2ptr $reference
210 212
211The opposite of C<ptr2ref>, above: returns the internal address of the 213The opposite of C<ptr2ref>, above: returns the internal address of the
212value pointed to by the passed reference. I<No checks whatsoever will be 214value pointed to by the passed reference. This function is safe to call on
213done>, so don't use this. 215anything, and returns the same value that a normal reference would if used
216in a numeric context.
214 217
215=back 218=back
216 219
217=head1 ENVIRONMENT VARIABLES 220=head1 ENVIRONMENT VARIABLES
218 221
219You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an 222You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
220integer to override the default depth in C<track>. If a call explicitly 223integer to override the default depth in C<track>. If a call explicitly
221specified a depth it is not overridden. 224specifies a depth, it is not overridden.
222 225
223=head1 AUTHOR 226=head1 AUTHOR
224 227
225Marc Lehmann <pcg@goof.com>. 228Marc Lehmann <pcg@goof.com>.
226 229
227=head1 COPYRIGHT AND LICENSE 230=head1 COPYRIGHT AND LICENSE
228 231
229Copyright (C) 2007, 2008 by Marc Lehmann. 232Copyright (C) 2007, 2008, 2009, 2013 by Marc Lehmann.
230 233
231This library is free software; you can redistribute it and/or modify 234This library is free software; you can redistribute it and/or modify
232it 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,
233at 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.
234 237

Diff Legend

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