[ViewVC] Diff of: cvs/Devel-FindRef/FindRef.pm

Comparing Devel-FindRef/FindRef.pm (file contents):
Revision 1.8 by root, Wed Nov 28 12:20:33 2007 UTC vs.
Revision 1.30 by root, Fri May 16 07:43:52 2014 UTC

…		…
1	package Devel::FindRef;	1	package Devel::FindRef;
2		2
3	use strict;	3	use common::sense;
4		4
5	use XSLoader;	5	use XSLoader;
		6	use Scalar::Util;
6		7
7	BEGIN {	8	BEGIN {
8	our $VERSION = '1.0';	9	our $VERSION = '1.43';
9	XSLoader::load __PACKAGE__, $VERSION;	10	XSLoader::load __PACKAGE__, $VERSION;
10	}	11	}
11		12
12	=head1 NAME	13	=head1 NAME
13		14
14	Devel::FindRef - where is that reference to my scalar hiding?	15	Devel::FindRef - where is that reference to my variable hiding?
15		16
16	=head1 SYNOPSIS	17	=head1 SYNOPSIS
17		18
18	use Devel::FindRef;	19	use Devel::FindRef;
		20
		21	print Devel::FindRef::track \$some_variable;
19		22
20	=head1 DESCRIPTION	23	=head1 DESCRIPTION
21		24
22	Tracking down reference problems (e.g. you expect some object to be	25	Tracking down reference problems (e.g. you expect some object to be
23	destroyed, but there are still references to it that keep it alive) can be	26	destroyed, but there are still references to it that keep it alive) can be
27	The C<track> function can help track down some of those references back to	30	The C<track> function can help track down some of those references back to
28	the variables containing them.	31	the variables containing them.
29		32
30	For example, for this fragment:	33	For example, for this fragment:
31		34
32	package Test;	35	package Test;
		36
		37	use Devel::FindRef;
		38	use Scalar::Util;
33		39
34	our $var = "hi\n";	40	our $var = "hi\n";
35	my $x = \$var;	41	my $global_my = \$var;
36	our %hash = (ukukey => \$var);	42	our %global_hash = (ukukey => \$var);
37	our $hash2 = {ukukey2 => \$var};	43	our $global_hashref = { ukukey2 => \$var };
38		44
39	sub testsub {	45	sub testsub {
40	my $local = $hash2;	46	my $testsub_local = $global_hashref;
41	print Devel::FindRef::track \$var;	47	print Devel::FindRef::track \$var;
42	}	48	}
43		49
44	testsub;	50	my $closure = sub {
		51	my $closure_var = \$_[0];
		52	Scalar::Util::weaken (my $weak_ref = \$var);
		53	testsub;
		54	};
		55
		56	$closure->($var);
45		57
46	The output is as follows (or similar to this, in case I forget to update	58	The output is as follows (or similar to this, in case I forget to update
47	the manpage after some changes):	59	the manpage after some changes):
48		60
49	SCALAR(0x676fa0) is	61	SCALAR(0x7cc888) [refcount 6] is
50	referenced by REF(0x676fb0), which is	62	+- referenced by REF(0x8abcc8) [refcount 1], which is
51	in the lexical '$x' in CODE(0x676370), which is	63	\| the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
52	not found anywhere I looked :(	64	\| +- the closure created at tst:18.
53	referenced by REF(0x676360), which is	65	\| +- referenced by REF(0x7d3c58) [refcount 1], which is
54	in the member 'ukukey' of HASH(0x756660), which is	66	\| \| the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
55	in the global %Test::hash.	67	\| \| +- the containing scope for CODE(0x8ab430) [refcount 3], which is
		68	\| \| \| the global &Test::testsub.
		69	\| \| +- the main body of the program.
		70	\| +- the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before.
		71	+- referenced by REF(0x7cc7c8) [refcount 1], which is
		72	\| the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before.
56	in the global $Test::var.	73	+- the global $Test::var.
		74	+- referenced by REF(0x7cc558) [refcount 1], which is
		75	\| the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is
		76	\| +- referenced by REF(0x8abad0) [refcount 1], which is
		77	\| \| the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before.
		78	\| +- referenced by REF(0x8ab4f0) [refcount 1], which is
		79	\| the global $Test::global_hashref.
		80	+- referenced by REF(0x7ae518) [refcount 1], which is
		81	\| the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is
		82	\| the global %Test::global_hash.
57	referenced by REF(0x6760e0), which is	83	+- referenced by REF(0x7ae2f0) [refcount 1], which is
58	in the member 'ukukey2' of HASH(0x676f30), which is	84	a temporary on the stack.
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		85
66	It is a bit convoluted to read, but basically it says that the value	86	It is a bit convoluted to read, but basically it says that the value
67	stored in C<$var> can be found:	87	stored in C<$var> is referenced by:
68		88
69	=over 4	89	=over 4
70		90
71	=item - in some variable C<$x> whose origin is not known (I frankly have no	91	=item - the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
72	idea why, hints accepted).	92	closure, which in turn is used quite a bit.
73		93
74	=item - in the hash element with key C<ukukey> in the hash stored in C<%Test::hash>.	94	=item - the package-level lexical C<$global_my>.
75		95
76	=item - in the global variable named C<$Test::var>.	96	=item - the global package variable named C<$Test::var>.
77		97
78	=item - in the hash element C<ukukey2>, in the hash in the my variable	98	=item - 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	99	C<$testsub_local> in the sub C<Test::testsub> and also in the hash
		100	C<$referenced by Test::hash2>.
		101
		102	=item - the hash element with key C<ukukey> in the hash stored in
80	C<$Test::hash2>.	103	C<%Test::hash>.
		104
		105	=item - some anonymous mortalised reference on the stack (which is caused
		106	by calling C<track> with the expression C<\$var>, which creates the
		107	reference).
81		108
82	=back	109	=back
		110
		111	And all these account for six reference counts.
83		112
84	=head1 EXPORTS	113	=head1 EXPORTS
85		114
86	None.	115	None.
87		116
…		…
93		122
94	Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and	123	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	124	return a descriptive string. C<$ref> can point at any perl value, be it
96	anonymous sub, hash, array, scalar etc.	125	anonymous sub, hash, array, scalar etc.
97		126
98	This is the function you most often use.	127	This is the function you most likely want to use when tracking down
		128	references.
99		129
100	=cut	130	=cut
101		131
102	sub find($);	132	sub find($);
103		133
		134	sub _f($) {
		135	"$_[0] [refcount " . (_refcnt $_[0]) . "]"
		136	}
		137
104	sub track {	138	sub track {
		139	my ($ref, $depth) = @_;
		140	@_ = ();
		141
105	my $buf = "";	142	my $buf = "";
106	my %ignore;	143	my %seen;
		144
		145	Scalar::Util::weaken $ref;
107		146
108	my $track; $track = sub {	147	my $track; $track = sub {
109	my ($target, $depth, $indent) = @_;	148	my ($refref, $depth, $indent) = @_;
110	@_ = ();
111	local $ignore{$target+0} = undef;
112		149
113	if ($depth) {	150	if ($depth) {
114	my (@about) = grep !exists $ignore{$_->[1]}, find $target;	151	my (@about) = find $$refref;
115	if (@about) {	152	if (@about) {
116	local @ignore{map $_->[1]+0, @about} = ();
117	for my $about (@about) {	153	for my $about (@about) {
118	local $ignore{$about+0} = undef;	154	$about->[0] =~ s/([^\x20-\x7e])/sprintf "\\{%02x}", ord $1/ge;
119	$buf .= (" ") x $indent;	155	$buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
120	$buf .= $about->[0];
121	if (@$about > 1) {	156	if (@$about > 1) {
		157	if ($seen{ref2ptr $about->[1]}++) {
		158	$buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
		159	} else {
122	$buf .= " $about->[1], which is\n";	160	$buf .= " " . (_f $about->[1]) . ", which is\n";
123	$track->($about->[1], $depth - 1, $indent + 1);	161	$track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent\| ");
		162	}
124	} else {	163	} else {
125	$buf .= ".\n";	164	$buf .= ".\n";
126	}	165	}
127	}	166	}
128	} else {	167	} else {
129	$buf .= (" ") x $indent;
130	$buf .= "not found anywhere I looked :(\n";	168	$buf .= "$indent not found anywhere I looked :(\n";
131	}	169	}
132	} else {	170	} else {
133	$buf .= (" ") x $indent;
134	$buf .= "not referenced within the search depth.\n";	171	$buf .= "$indent not referenced within the search depth.\n";
135	}	172	}
136	};	173	};
137		174
138	$buf .= "$_[0] is\n";	175	$buf .= (_f $ref) . " is\n";
139	$track->($_[0], $_[1] \|\| 10, 1);	176
		177	$track->(\$ref, $depth \|\| $ENV{PERL_DEVEL_FINDREF_DEPTH} \|\| 10, "");
140	$buf	178	$buf
141	}	179	}
142		180
143	=item @references = Devel::FindRef::find $ref	181	=item @references = Devel::FindRef::find $ref
144		182
145	Return arrayrefs that contain [$message, $ref] pairs. The message	183	Return arrayrefs that contain [$message, $ref] pairs. The message
146	describes what kind of reference was found and the C<$ref> is the	184	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	185	reference itself, which can be omitted if C<find> decided to end the
148	search.	186	search. The returned references are all weak references.
149		187
150	The C<track> function uses this to find references to the value you are	188	The C<track> function uses this to find references to the value you are
151	interested in and recurses on the returned references.	189	interested in and recurses on the returned references.
152		190
153	=cut	191	=cut
154		192
155	sub find($) {	193	sub find($) {
156	my ($about, $excl) = &find_;	194	my ($about, $excl) = &find_;
157	my %excl = map +($_ => undef), @$excl;	195	my %excl = map +($_ => undef), @$excl;
158	grep !exists $excl{$_->[1] + 0}, @$about	196	grep !($#$_ && exists $excl{ref2ptr $_->[1]}), @$about
159	}	197	}
160		198
161	=item $ref = Devel::FindRef::ptr2ref $integer	199	=item $ref = Devel::FindRef::ptr2ref $integer
162		200
163	Sometimes you know (from debugging output) the address of a perl scalar	201	Sometimes you know (from debugging output) the address of a perl value you
164	you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used	202	are interested in (e.g. C<HASH(0x176ff70)>). This function can be used to
165	to turn the address into a reference to that scalar. It is quite safe to	203	turn the address into a reference to that value. It is quite safe to call
166	call on valid addresses, but extremely dangerous to call on invalid ones.	204	on valid addresses, but extremely dangerous to call on invalid ones. I<No
		205	checks whatsoever will be done>, so don't use this unless you really know
		206	the value is the address of a valid perl value.
167		207
168	# we know that HASH(0x176ff70) exists, so turn it into a hashref:	208	# we know that HASH(0x176ff70) exists, so turn it into a hashref:
169	my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;	209	my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
170		210
		211	=item $ptr = Devel::FindRef::ref2ptr $reference
		212
		213	The opposite of C<ptr2ref>, above: returns the internal address of the
		214	value pointed to by the passed reference. This function is safe to call on
		215	anything, and returns the same value taht a normal reference would if used
		216	in a numeric context.
		217
171	=back	218	=back
172		219
		220	=head1 ENVIRONMENT VARIABLES
		221
		222	You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
		223	integer to override the default depth in C<track>. If a call explicitly
		224	specifies a depth, it is not overridden.
		225
173	=head1 AUTHOR	226	=head1 AUTHOR
174		227
175	Marc Lehmann <pcg@goof.com>.	228	Marc Lehmann <pcg@goof.com>.
176		229
177	=head1 BUGS
178
179	Only code values, arrays, hashes, scalars and magic are being looked at.
180
181	This is a quick hack only.
182
183	=head1 COPYRIGHT AND LICENSE	230	=head1 COPYRIGHT AND LICENSE
184		231
185	Copyright (C) 2007 by Marc Lehmann.	232	Copyright (C) 2007, 2008, 2009, 2013 by Marc Lehmann.
186		233
187	This library is free software; you can redistribute it and/or modify	234	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,	235	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.	236	at your option, any later version of Perl 5 you may have available.
190		237

Diff Legend

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

Comparing Devel-FindRef/FindRef.pm (file contents): Revision 1.8 by root, Wed Nov 28 12:20:33 2007 UTC vs. Revision 1.30 by root, Fri May 16 07:43:52 2014 UTC

Diff Legend

Comparing Devel-FindRef/FindRef.pm (file contents):
Revision 1.8 by root, Wed Nov 28 12:20:33 2007 UTC vs.
Revision 1.30 by root, Fri May 16 07:43:52 2014 UTC