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.12 by root, Fri Jul 11 21:09:30 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.2';
9 XSLoader::load __PACKAGE__, $VERSION; 10 XSLoader::load __PACKAGE__, $VERSION;
10} 11}
11 12
12=head1 NAME 13=head1 NAME
13 14
… …
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(0x7bd2d0) is
51 in the global $Test::var.
50 referenced by REF(0x676fb0), which is 52 referenced by REF(0x7bd240), which is
53 in the member 'ukukey2' of HASH(0x7bd228), which is
54 referenced by REF(0x81dae8), which is
55 in the lexical '$local' in CODE(0x81da88), which is
56 in the global &Test::testsub.
57 referenced by REF(0x81da40), which is
58 in the global $Test::hash2.
59 referenced by REF(0x79f3f8), which is
51 in the lexical '$x' in CODE(0x676370), which is 60 in the lexical '$x' in CODE(0x79f518), which is
61 the containing scope for CODE(0x81da88), which is
62 in the global &Test::testsub.
63 referenced by REF(0x79f2f0), which is
52 not found anywhere I looked :( 64 not found anywhere I looked :(
53 referenced by REF(0x676360), which is 65 referenced by REF(0x79f140), which is
54 in the member 'ukukey' of HASH(0x756660), which is 66 in the member 'ukukey' of HASH(0x81d698), which is
55 in the global %Test::hash. 67 in the global %Test::hash.
56 in the global $Test::var.
57 referenced by REF(0x6760e0), which is
58 in the member 'ukukey2' of HASH(0x676f30), which is
59 referenced by REF(0x77bcf0), which is
60 in the lexical '$local' in CODE(0x77bcb0), which is
61 in the global &Test::testsub.
62 referenced by REF(0x77bc80), which is
63 in the global $Test::hash2.
64
65 68
66It is a bit convoluted to read, but basically it says that the value 69It is a bit convoluted to read, but basically it says that the value
67stored in C<$var> can be found: 70stored in C<$var> can be found:
68 71
69=over 4 72=over 4
… …
100=cut 103=cut
101 104
102sub find($); 105sub find($);
103 106
104sub track { 107sub track {
108 my ($ref, $depth) = @_;
109 @_ = ();
110
105 my $buf = ""; 111 my $buf = "";
106 my %ignore; 112 my %seen;
113
114 Scalar::Util::weaken $ref;
107 115
108 my $track; $track = sub { 116 my $track; $track = sub {
109 my ($target, $depth, $indent) = @_; 117 my ($refref, $depth, $indent) = @_;
110 @_ = ();
111 local $ignore{$target+0} = undef;
112 118
113 if ($depth) { 119 if ($depth) {
114 my (@about) = grep !exists $ignore{$_->[1]}, find $target; 120 my (@about) = find $$refref;
115 if (@about) { 121 if (@about) {
116 local @ignore{map $_->[1]+0, @about} = ();
117 for my $about (@about) { 122 for my $about (@about) {
118 local $ignore{$about+0} = undef; 123 $buf .= "$indent" . (@about > 1 ? "+- " : " ") . $about->[0];
119 $buf .= (" ") x $indent;
120 $buf .= $about->[0];
121 if (@$about > 1) { 124 if (@$about > 1) {
125 if ($seen{$about->[1]+0}++) {
126 $buf .= " $about->[1], which was seen before.\n";
127 } else {
122 $buf .= " $about->[1], which is\n"; 128 $buf .= " $about->[1], which is\n";
123 $track->($about->[1], $depth - 1, $indent + 1); 129 $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
130 }
124 } else { 131 } else {
125 $buf .= ".\n"; 132 $buf .= ".\n";
126 } 133 }
127 } 134 }
128 } else { 135 } else {
129 $buf .= (" ") x $indent;
130 $buf .= "not found anywhere I looked :(\n"; 136 $buf .= "$indent not found anywhere I looked :(\n";
131 } 137 }
132 } else { 138 } else {
133 $buf .= (" ") x $indent;
134 $buf .= "not referenced within the search depth.\n"; 139 $buf .= "$indent not referenced within the search depth.\n";
135 } 140 }
136 }; 141 };
137 142
138 $buf .= "$_[0] is\n"; 143 $buf .= "$ref is\n";
139 $track->($_[0], $_[1] || 10, 1); 144 $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
140 $buf 145 $buf
141} 146}
142 147
143=item @references = Devel::FindRef::find $ref 148=item @references = Devel::FindRef::find $ref
144 149
145Return arrayrefs that contain [$message, $ref] pairs. The message 150Return arrayrefs that contain [$message, $ref] pairs. The message
146describes what kind of reference was found and the C<$ref> is the 151describes 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 152reference itself, which can be omitted if C<find> decided to end the
148search. 153search. The returned references are all weak references.
149 154
150The C<track> function uses this to find references to the value you are 155The C<track> function uses this to find references to the value you are
151interested in and recurses on the returned references. 156interested in and recurses on the returned references.
152 157
153=cut 158=cut
… …
168 # we know that HASH(0x176ff70) exists, so turn it into a hashref: 173 # we know that HASH(0x176ff70) exists, so turn it into a hashref:
169 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70; 174 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
170 175
171=back 176=back
172 177
178=head1 ENVIRONMENT VARIABLES
179
180You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
181integer to override the default depth in C<track>. If a call explicitly
182specified a depth it is not overridden.
183
173=head1 AUTHOR 184=head1 AUTHOR
174 185
175Marc Lehmann <pcg@goof.com>. 186Marc Lehmann <pcg@goof.com>.
176 187
177=head1 BUGS 188=head1 BUGS

Diff Legend

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