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.1 by root, Thu Jan 11 22:30:34 2007 UTC vs.
Revision 1.7 by root, Mon Apr 30 21:08:14 2007 UTC

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

Diff Legend

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