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.3 by root, Thu Jan 11 23:13:37 2007 UTC vs.
Revision 1.8 by root, Wed Nov 28 12:20:33 2007 UTC

… …
2 2
3use strict; 3use strict;
4 4
5use XSLoader; 5use XSLoader;
6 6
7
8BEGIN { 7BEGIN {
9 our $VERSION = '0.1'; 8 our $VERSION = '1.0';
10 XSLoader::load __PACKAGE__, $VERSION; 9 XSLoader::load __PACKAGE__, $VERSION;
11} 10}
12 11
13=head1 NAME 12=head1 NAME
14 13
… …
19 use Devel::FindRef; 18 use Devel::FindRef;
20 19
21=head1 DESCRIPTION 20=head1 DESCRIPTION
22 21
23Tracking down reference problems (e.g. you expect some object to be 22Tracking down reference problems (e.g. you expect some object to be
24destroyed, but there are still references to it that keep it alive). can 23destroyed, but there are still references to it that keep it alive) can be
25be very hard, although perl keeps track of all values. 24very hard. Fortunately, perl keeps track of all its values, so tracking
25references "backwards" is usually possible.
26 26
27The C<track> function can hlep track down some of those refernces back to 27The C<track> function can help track down some of those references back to
28the variables containing them. 28the variables containing them.
29 29
30For example, for this fragment: 30For example, for this fragment:
31 31
32 package Test; 32 package Test;
… …
41 print Devel::FindRef::track \$var; 41 print Devel::FindRef::track \$var;
42 } 42 }
43 43
44 testsub; 44 testsub;
45 45
46The output is as follows (or similar to htis, in case I forget to update 46The output is as follows (or similar to this, in case I forget to update
47the manpage after some changes): 47the manpage after some changes):
48 48
49 SCALAR(0x676fa0) is 49 SCALAR(0x676fa0) is
50 referenced by REF(0x676fb0), which is 50 referenced by REF(0x676fb0), which is
51 in the lexical '$x' in CODE(0x676370), which is 51 in the lexical '$x' in CODE(0x676370), which is
… …
61 in the global &Test::testsub. 61 in the global &Test::testsub.
62 referenced by REF(0x77bc80), which is 62 referenced by REF(0x77bc80), which is
63 in the global $Test::hash2. 63 in the global $Test::hash2.
64 64
65 65
66It is a bit convoluted to read, but basically it says that the value stored in C<$var> 66It is a bit convoluted to read, but basically it says that the value
67can be found: 67stored in C<$var> can be found:
68 68
69=over 4 69=over 4
70 70
71=item - in some variable C<$x> whose origin is not known (I frankly have no 71=item - in some variable C<$x> whose origin is not known (I frankly have no
72idea why, hints accepted). 72idea why, hints accepted).
… …
76=item - in the global variable named C<$Test::var>. 76=item - in the global variable named C<$Test::var>.
77 77
78=item - in the hash element C<ukukey2>, in the hash in the my variable 78=item - in the hash element C<ukukey2>, in the hash in the my variable
79C<$local> in the sub C<Test::testsub> and also in the hash referenced by 79C<$local> in the sub C<Test::testsub> and also in the hash referenced by
80C<$Test::hash2>. 80C<$Test::hash2>.
81
82=back
81 83
82=head1 EXPORTS 84=head1 EXPORTS
83 85
84None. 86None.
85 87
… …
99 101
100sub find($); 102sub find($);
101 103
102sub track { 104sub track {
103 my $buf = ""; 105 my $buf = "";
106 my %ignore;
104 107
105 my $track; $track = sub { 108 my $track; $track = sub {
106 my (undef, $depth, $indent) = @_; 109 my ($target, $depth, $indent) = @_;
110 @_ = ();
111 local $ignore{$target+0} = undef;
107 112
108 if ($depth) { 113 if ($depth) {
109 my (@about) = find $_[0]; 114 my (@about) = grep !exists $ignore{$_->[1]}, find $target;
110 if (@about) { 115 if (@about) {
116 local @ignore{map $_->[1]+0, @about} = ();
111 for my $about (@about) { 117 for my $about (@about) {
118 local $ignore{$about+0} = undef;
112 $buf .= (" ") x $indent; 119 $buf .= (" ") x $indent;
113 $buf .= $about->[0]; 120 $buf .= $about->[0];
114 if (@$about > 1) { 121 if (@$about > 1) {
115 $buf .= " $about->[1], which is\n"; 122 $buf .= " $about->[1], which is\n";
116 $track->($about->[1], $depth - 1, $indent + 1); 123 $track->($about->[1], $depth - 1, $indent + 1);
… …
145 152
146=cut 153=cut
147 154
148sub find($) { 155sub find($) {
149 my ($about, $excl) = &find_; 156 my ($about, $excl) = &find_;
150 my %excl = map +($_ => 1), @$excl; 157 my %excl = map +($_ => undef), @$excl;
151 grep !$excl{$_->[1] + 0}, @$about 158 grep !exists $excl{$_->[1] + 0}, @$about
152} 159}
153 160
154=item $ref = Devel::FindRef::ref2ptr $ptr 161=item $ref = Devel::FindRef::ptr2ref $integer
155 162
156Sometimes you know (from debugging output) the address of a perl scalar 163Sometimes you know (from debugging output) the address of a perl scalar
157you are interested in. This function can be used to turn the address into 164you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used
158a reference to that scalar. It is quite safe to call on valid addresses, 165to turn the address into a reference to that scalar. It is quite safe to
159but extremely dangerous to call on invalid ones. 166call on valid addresses, but extremely dangerous to call on invalid ones.
167
168 # we know that HASH(0x176ff70) exists, so turn it into a hashref:
169 my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
160 170
161=back 171=back
162 172
163=head1 AUTHOR 173=head1 AUTHOR
164 174
165Marc Lehmann <pcg@goof.com>. 175Marc Lehmann <pcg@goof.com>.
166 176
167=head1 BUGS 177=head1 BUGS
168 178
169Only code values, arrays, hashes, scalars and magic are being looked at. 179Only code values, arrays, hashes, scalars and magic are being looked at.
180
181This is a quick hack only.
170 182
171=head1 COPYRIGHT AND LICENSE 183=head1 COPYRIGHT AND LICENSE
172 184
173Copyright (C) 2007 by Marc Lehmann. 185Copyright (C) 2007 by Marc Lehmann.
174 186

Diff Legend

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