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