ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.pm
Revision: 1.6
Committed: Sat Mar 24 19:18:18 2007 UTC (17 years, 1 month ago) by root
Branch: MAIN
Changes since 1.5: +11 -4 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 package Devel::FindRef;
2    
3     use strict;
4    
5     use XSLoader;
6    
7    
8     BEGIN {
9 root 1.5 our $VERSION = '0.2';
10 root 1.1 XSLoader::load __PACKAGE__, $VERSION;
11     }
12    
13     =head1 NAME
14    
15     Devel::FindRef - where is that reference to my scalar hiding?
16    
17     =head1 SYNOPSIS
18    
19     use Devel::FindRef;
20    
21     =head1 DESCRIPTION
22    
23     Tracking down reference problems (e.g. you expect some object to be
24 root 1.4 destroyed, but there are still references to it that keep it alive) can be
25     very hard. Fortunately, perl keeps track of all its values, so tracking
26     references "backwards" is usually possible.
27 root 1.1
28 root 1.4 The C<track> function can help track down some of those references back to
29 root 1.1 the variables containing them.
30    
31     For example, for this fragment:
32    
33     package Test;
34    
35     our $var = "hi\n";
36     my $x = \$var;
37     our %hash = (ukukey => \$var);
38     our $hash2 = {ukukey2 => \$var};
39    
40     sub testsub {
41     my $local = $hash2;
42     print Devel::FindRef::track \$var;
43     }
44    
45     testsub;
46    
47 root 1.4 The output is as follows (or similar to this, in case I forget to update
48 root 1.3 the manpage after some changes):
49 root 1.1
50     SCALAR(0x676fa0) is
51     referenced by REF(0x676fb0), which is
52     in the lexical '$x' in CODE(0x676370), which is
53     not found anywhere I looked :(
54     referenced by REF(0x676360), which is
55     in the member 'ukukey' of HASH(0x756660), which is
56     in the global %Test::hash.
57     in the global $Test::var.
58     referenced by REF(0x6760e0), which is
59     in the member 'ukukey2' of HASH(0x676f30), which is
60     referenced by REF(0x77bcf0), which is
61     in the lexical '$local' in CODE(0x77bcb0), which is
62     in the global &Test::testsub.
63     referenced by REF(0x77bc80), which is
64     in the global $Test::hash2.
65    
66    
67 root 1.4 It is a bit convoluted to read, but basically it says that the value
68     stored in C<$var> can be found:
69 root 1.1
70     =over 4
71    
72     =item - in some variable C<$x> whose origin is not known (I frankly have no
73     idea why, hints accepted).
74    
75     =item - in the hash element with key C<ukukey> in the hash stored in C<%Test::hash>.
76    
77     =item - in the global variable named C<$Test::var>.
78    
79     =item - in the hash element C<ukukey2>, in the hash in the my variable
80     C<$local> in the sub C<Test::testsub> and also in the hash referenced by
81     C<$Test::hash2>.
82    
83 root 1.6 =back
84    
85 root 1.1 =head1 EXPORTS
86    
87     None.
88    
89     =head1 FUNCTIONS
90    
91     =over 4
92    
93     =item $string = Devel::FindRef::track $ref[, $depth]
94    
95     Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and
96     return a descriptive string. C<$ref> can point at any perl value, be it
97     anonymous sub, hash, array, scalar etc.
98    
99     This is the function you most often use.
100    
101     =cut
102    
103     sub find($);
104    
105     sub track {
106     my $buf = "";
107 root 1.6 my %ignore;
108 root 1.1
109     my $track; $track = sub {
110 root 1.6 my ($target, $depth, $indent) = @_;
111     @_ = ();
112     local $ignore{$target+0} = undef;
113 root 1.1
114     if ($depth) {
115 root 1.6 my (@about) = grep !exists $ignore{$_->[1]}, find $target;
116 root 1.1 if (@about) {
117 root 1.6 local @ignore{map $_->[1]+0, @about} = ();
118 root 1.1 for my $about (@about) {
119 root 1.6 local $ignore{$about+0} = undef;
120 root 1.1 $buf .= (" ") x $indent;
121     $buf .= $about->[0];
122     if (@$about > 1) {
123     $buf .= " $about->[1], which is\n";
124     $track->($about->[1], $depth - 1, $indent + 1);
125     } else {
126     $buf .= ".\n";
127     }
128     }
129     } else {
130     $buf .= (" ") x $indent;
131     $buf .= "not found anywhere I looked :(\n";
132     }
133     } else {
134     $buf .= (" ") x $indent;
135     $buf .= "not referenced within the search depth.\n";
136     }
137     };
138    
139     $buf .= "$_[0] is\n";
140     $track->($_[0], $_[1] || 10, 1);
141     $buf
142     }
143    
144     =item @references = Devel::FindRef::find $ref
145    
146     Return arrayrefs that contain [$message, $ref] pairs. The message
147     describes what kind of reference was found and the C<$ref> is the
148     reference itself, which cna be omitted if C<find> decided to end the
149     search.
150    
151     The C<track> function uses this to find references to the value you are
152     interested in and recurses on the returned references.
153    
154     =cut
155    
156     sub find($) {
157     my ($about, $excl) = &find_;
158 root 1.6 my %excl = map +($_ => undef), @$excl;
159     grep !exists $excl{$_->[1] + 0}, @$about
160 root 1.1 }
161    
162     =item $ref = Devel::FindRef::ref2ptr $ptr
163    
164     Sometimes you know (from debugging output) the address of a perl scalar
165     you are interested in. This function can be used to turn the address into
166     a reference to that scalar. It is quite safe to call on valid addresses,
167     but extremely dangerous to call on invalid ones.
168    
169     =back
170    
171     =head1 AUTHOR
172    
173     Marc Lehmann <pcg@goof.com>.
174    
175     =head1 BUGS
176    
177 root 1.2 Only code values, arrays, hashes, scalars and magic are being looked at.
178 root 1.1
179 root 1.4 This is a quick hack only.
180    
181 root 1.1 =head1 COPYRIGHT AND LICENSE
182    
183     Copyright (C) 2007 by Marc Lehmann.
184    
185     This library is free software; you can redistribute it and/or modify
186     it under the same terms as Perl itself, either Perl version 5.8.8 or,
187     at your option, any later version of Perl 5 you may have available.
188    
189     =cut
190    
191     1
192