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.8 by root, Wed Nov 28 12:20:33 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;
6use Scalar::Util;
6 7
7BEGIN { 8BEGIN {
8 our $VERSION = '1.0'; 9 our $VERSION = '1.3';
9 XSLoader::load __PACKAGE__, $VERSION; 10 XSLoader::load __PACKAGE__, $VERSION;
10} 11}
11 12
12=head1 NAME 13=head1 NAME
13 14
14Devel::FindRef - where is that reference to my scalar hiding? 15Devel::FindRef - where is that reference to my variable hiding?
15 16
16=head1 SYNOPSIS 17=head1 SYNOPSIS
17 18
18 use Devel::FindRef; 19 use Devel::FindRef;
19 20
… …
44 testsub; 45 testsub;
45 46
46The output is as follows (or similar to this, in case I forget to update 47The output is as follows (or similar to this, in case I forget to update
47the manpage after 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
65 67
66It is a bit convoluted to read, but basically it says that the value 68It is a bit convoluted to read, but basically it says that the value
67stored in C<$var> can be found: 69stored in C<$var> can be found:
68 70
69=over 4 71=over 4
… …
100=cut 102=cut
101 103
102sub find($); 104sub find($);
103 105
104sub track { 106sub track {
107 my ($ref, $depth) = @_;
108 @_ = ();
109
105 my $buf = ""; 110 my $buf = "";
106 my %ignore; 111 my %seen;
112
113 Scalar::Util::weaken $ref;
107 114
108 my $track; $track = sub { 115 my $track; $track = sub {
109 my ($target, $depth, $indent) = @_; 116 my ($refref, $depth, $indent) = @_;
110 @_ = ();
111 local $ignore{$target+0} = undef;
112 117
113 if ($depth) { 118 if ($depth) {
114 my (@about) = grep !exists $ignore{$_->[1]}, find $target; 119 my (@about) = find $$refref;
115 if (@about) { 120 if (@about) {
116 local @ignore{map $_->[1]+0, @about} = ();
117 for my $about (@about) { 121 for my $about (@about) {
118 local $ignore{$about+0} = undef; 122 $buf .= "$indent" . (@about > 1 ? "+- " : " ") . $about->[0];
119 $buf .= (" ") x $indent;
120 $buf .= $about->[0];
121 if (@$about > 1) { 123 if (@$about > 1) {
124 if ($seen{ref2ptr $about->[1]}++) {
125 $buf .= " $about->[1], which was seen before.\n";
126 } else {
122 $buf .= " $about->[1], which is\n"; 127 $buf .= " $about->[1], which is\n";
123 $track->($about->[1], $depth - 1, $indent + 1); 128 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
129 }
124 } else { 130 } else {
125 $buf .= ".\n"; 131 $buf .= ".\n";
126 } 132 }
127 } 133 }
128 } else { 134 } else {
129 $buf .= (" ") x $indent;
130 $buf .= "not found anywhere I looked :(\n"; 135 $buf .= "$indent not found anywhere I looked :(\n";
131 } 136 }
132 } else { 137 } else {
133 $buf .= (" ") x $indent;
134 $buf .= "not referenced within the search depth.\n"; 138 $buf .= "$indent not referenced within the search depth.\n";
135 } 139 }
136 }; 140 };
137 141
138 $buf .= "$_[0] is\n"; 142 $buf .= "$ref is\n";
139 $track->($_[0], $_[1] || 10, 1); 143 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
140 $buf 144 $buf
141} 145}
142 146
143=item @references = Devel::FindRef::find $ref 147=item @references = Devel::FindRef::find $ref
144 148
145Return arrayrefs that contain [$message, $ref] pairs. The message 149Return arrayrefs that contain [$message, $ref] pairs. The message
146describes 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
147reference 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
148search. 152search. The returned references are all weak references.
149 153
150The 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
151interested in and recurses on the returned references. 155interested in and recurses on the returned references.
152 156
153=cut 157=cut
154 158
155sub find($) { 159sub find($) {
156 my ($about, $excl) = &find_; 160 my ($about, $excl) = &find_;
157 my %excl = map +($_ => undef), @$excl; 161 my %excl = map +($_ => undef), @$excl;
158 grep !exists $excl{$_->[1] + 0}, @$about 162 grep !exists $excl{ref2ptr $_->[1]}, @$about
159} 163}
160 164
161=item $ref = Devel::FindRef::ptr2ref $integer 165=item $ref = Devel::FindRef::ptr2ref $integer
162 166
163Sometimes you know (from debugging output) the address of a perl scalar 167Sometimes you know (from debugging output) the address of a perl scalar
… …
166call on valid addresses, but extremely dangerous to call on invalid ones. 170call on valid addresses, but extremely dangerous to call on invalid ones.
167 171
168 # we know that HASH(0x176ff70) exists, so turn it into a hashref: 172 # we know that HASH(0x176ff70) exists, so turn it into a hashref:
169 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70; 173 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
170 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.
180
171=back 181=back
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.
172 188
173=head1 AUTHOR 189=head1 AUTHOR
174 190
175Marc Lehmann <pcg@goof.com>. 191Marc Lehmann <pcg@goof.com>.
176 192

Diff Legend

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