ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.pm
Revision: 1.9
Committed: Sat Dec 29 21:04:46 2007 UTC (16 years, 4 months ago) by root
Branch: MAIN
CVS Tags: rel-1_1
Changes since 1.8: +14 -13 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 root 1.9 use Scalar::Util;
7 root 1.1
8     BEGIN {
9 root 1.9 our $VERSION = '1.1';
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 root 1.9 my ($ref, $depth) = @_;
107     @_ = ();
108    
109 root 1.1 my $buf = "";
110 root 1.9
111     Scalar::Util::weaken $ref;
112 root 1.1
113     my $track; $track = sub {
114 root 1.9 my ($refref, $depth, $indent) = @_;
115 root 1.1
116     if ($depth) {
117 root 1.9 my (@about) = find $$refref;
118 root 1.1 if (@about) {
119     for my $about (@about) {
120     $buf .= (" ") x $indent;
121     $buf .= $about->[0];
122     if (@$about > 1) {
123     $buf .= " $about->[1], which is\n";
124 root 1.9 $track->(\$about->[1], $depth - 1, $indent + 1);
125 root 1.1 } 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 root 1.9 $buf .= "$ref is\n";
140     $track->(\$ref, $depth || 10, 1);
141 root 1.1 $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 root 1.9 reference itself, which can be omitted if C<find> decided to end the
149     search. The returned references are all weak references.
150 root 1.1
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 root 1.7 =item $ref = Devel::FindRef::ptr2ref $integer
163 root 1.1
164     Sometimes you know (from debugging output) the address of a perl scalar
165 root 1.7 you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used
166     to turn the address into a reference to that scalar. It is quite safe to
167     call 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;
171 root 1.1
172     =back
173    
174     =head1 AUTHOR
175    
176     Marc Lehmann <pcg@goof.com>.
177    
178     =head1 BUGS
179    
180 root 1.2 Only code values, arrays, hashes, scalars and magic are being looked at.
181 root 1.1
182 root 1.4 This is a quick hack only.
183    
184 root 1.1 =head1 COPYRIGHT AND LICENSE
185    
186     Copyright (C) 2007 by Marc Lehmann.
187    
188     This library is free software; you can redistribute it and/or modify
189     it under the same terms as Perl itself, either Perl version 5.8.8 or,
190     at your option, any later version of Perl 5 you may have available.
191    
192     =cut
193    
194     1
195