ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Devel-FindRef/FindRef.pm
Revision: 1.10
Committed: Sat Apr 26 03:15:28 2008 UTC (16 years ago) by root
Branch: MAIN
CVS Tags: rel-1_2
Changes since 1.9: +16 -14 lines
Log Message:
1.2

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.10 our $VERSION = '1.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 root 1.10 SCALAR(0x7bd2d0) is
51 root 1.1 in the global $Test::var.
52 root 1.10 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 root 1.1 in the global &Test::testsub.
57 root 1.10 referenced by REF(0x81da40), which is
58 root 1.1 in the global $Test::hash2.
59 root 1.10 referenced by REF(0x79f3f8), 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
64     not found anywhere I looked :(
65     referenced by REF(0x79f140), which is
66     in the member 'ukukey' of HASH(0x81d698), which is
67     in the global %Test::hash.
68 root 1.1
69 root 1.4 It is a bit convoluted to read, but basically it says that the value
70     stored in C<$var> can be found:
71 root 1.1
72     =over 4
73    
74     =item - in some variable C<$x> whose origin is not known (I frankly have no
75     idea why, hints accepted).
76    
77     =item - in the hash element with key C<ukukey> in the hash stored in C<%Test::hash>.
78    
79     =item - in the global variable named C<$Test::var>.
80    
81     =item - in the hash element C<ukukey2>, in the hash in the my variable
82     C<$local> in the sub C<Test::testsub> and also in the hash referenced by
83     C<$Test::hash2>.
84    
85 root 1.6 =back
86    
87 root 1.1 =head1 EXPORTS
88    
89     None.
90    
91     =head1 FUNCTIONS
92    
93     =over 4
94    
95     =item $string = Devel::FindRef::track $ref[, $depth]
96    
97     Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and
98     return a descriptive string. C<$ref> can point at any perl value, be it
99     anonymous sub, hash, array, scalar etc.
100    
101     This is the function you most often use.
102    
103     =cut
104    
105     sub find($);
106    
107     sub track {
108 root 1.9 my ($ref, $depth) = @_;
109     @_ = ();
110    
111 root 1.1 my $buf = "";
112 root 1.9
113     Scalar::Util::weaken $ref;
114 root 1.1
115     my $track; $track = sub {
116 root 1.9 my ($refref, $depth, $indent) = @_;
117 root 1.1
118     if ($depth) {
119 root 1.9 my (@about) = find $$refref;
120 root 1.1 if (@about) {
121     for my $about (@about) {
122     $buf .= (" ") x $indent;
123     $buf .= $about->[0];
124     if (@$about > 1) {
125     $buf .= " $about->[1], which is\n";
126 root 1.9 $track->(\$about->[1], $depth - 1, $indent + 1);
127 root 1.1 } else {
128     $buf .= ".\n";
129     }
130     }
131     } else {
132     $buf .= (" ") x $indent;
133     $buf .= "not found anywhere I looked :(\n";
134     }
135     } else {
136     $buf .= (" ") x $indent;
137     $buf .= "not referenced within the search depth.\n";
138     }
139     };
140    
141 root 1.9 $buf .= "$ref is\n";
142     $track->(\$ref, $depth || 10, 1);
143 root 1.1 $buf
144     }
145    
146     =item @references = Devel::FindRef::find $ref
147    
148     Return arrayrefs that contain [$message, $ref] pairs. The message
149     describes what kind of reference was found and the C<$ref> is the
150 root 1.9 reference itself, which can be omitted if C<find> decided to end the
151     search. The returned references are all weak references.
152 root 1.1
153     The C<track> function uses this to find references to the value you are
154     interested in and recurses on the returned references.
155    
156     =cut
157    
158     sub find($) {
159     my ($about, $excl) = &find_;
160 root 1.6 my %excl = map +($_ => undef), @$excl;
161     grep !exists $excl{$_->[1] + 0}, @$about
162 root 1.1 }
163    
164 root 1.7 =item $ref = Devel::FindRef::ptr2ref $integer
165 root 1.1
166     Sometimes you know (from debugging output) the address of a perl scalar
167 root 1.7 you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used
168     to turn the address into a reference to that scalar. It is quite safe to
169     call on valid addresses, but extremely dangerous to call on invalid ones.
170    
171     # we know that HASH(0x176ff70) exists, so turn it into a hashref:
172     my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
173 root 1.1
174     =back
175    
176     =head1 AUTHOR
177    
178     Marc Lehmann <pcg@goof.com>.
179    
180     =head1 BUGS
181    
182 root 1.2 Only code values, arrays, hashes, scalars and magic are being looked at.
183 root 1.1
184 root 1.4 This is a quick hack only.
185    
186 root 1.1 =head1 COPYRIGHT AND LICENSE
187    
188     Copyright (C) 2007 by Marc Lehmann.
189    
190     This library is free software; you can redistribute it and/or modify
191     it under the same terms as Perl itself, either Perl version 5.8.8 or,
192     at your option, any later version of Perl 5 you may have available.
193    
194     =cut
195    
196     1
197