r34814 - in /branches/upstream/libdevel-findref-perl: ./ current/ current/COPYING current/Changes current/FindRef.pm current/FindRef.xs current/MANIFEST current/META.yml current/Makefile.PL current/README current/t/ current/t/00_load.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Tue May 5 23:41:06 UTC 2009
Author: jawnsy-guest
Date: Tue May 5 23:41:01 2009
New Revision: 34814
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34814
Log:
[svn-inject] Installing original source of libdevel-findref-perl
Added:
branches/upstream/libdevel-findref-perl/
branches/upstream/libdevel-findref-perl/current/
branches/upstream/libdevel-findref-perl/current/COPYING
branches/upstream/libdevel-findref-perl/current/Changes
branches/upstream/libdevel-findref-perl/current/FindRef.pm
branches/upstream/libdevel-findref-perl/current/FindRef.xs
branches/upstream/libdevel-findref-perl/current/MANIFEST
branches/upstream/libdevel-findref-perl/current/META.yml
branches/upstream/libdevel-findref-perl/current/Makefile.PL
branches/upstream/libdevel-findref-perl/current/README
branches/upstream/libdevel-findref-perl/current/t/
branches/upstream/libdevel-findref-perl/current/t/00_load.t
Added: branches/upstream/libdevel-findref-perl/current/COPYING
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/COPYING?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/COPYING (added)
+++ branches/upstream/libdevel-findref-perl/current/COPYING Tue May 5 23:41:01 2009
@@ -1,0 +1,7 @@
+
+Copyright (C) 2007 by Marc Lehmann.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.8 or,
+at your option, any later version of Perl 5 you may have available.
+
Added: branches/upstream/libdevel-findref-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/Changes?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/Changes (added)
+++ branches/upstream/libdevel-findref-perl/current/Changes Tue May 5 23:41:01 2009
@@ -1,0 +1,47 @@
+Revision history for Perl extension Devel::FindRef
+
+TODO: unwrap the save stack to find mortalised scalars (too version dependent).
+TODO: get the stack non-running coroutine?
+
+1.4 Mon Dec 1 14:43:35 CET 2008
+ - show refcount for each scalar.
+ - indicate that scalars are mortalised (but not where).
+ - flatten the results slightly.
+
+1.31 Sun Jul 20 18:38:17 CEST 2008
+ - correctly identify the main program and function call
+ argument vectors (patch by Paul LeoNerd Evans).
+ - use ref2ptr instead of +0 to correctly get the address
+ of overloaded variables (reported by Paul LeoNerd Evans).
+ - use UV in ptr2ref, as perl seems to do the same internally.
+
+1.3 Sat Jul 12 00:17:03 CEST 2008
+ - ignore the new "our" PVMG sv's from perl 5.10.
+ - apply a lot of fixes by Chris Heath,
+ handling constant functions and WEAKOUTSIDE better.
+ - avoid following circular reference chains.
+ - add some visual clues to the output string.
+ - look into anonymous closures to see where they were cloned.
+ - introduce PERL_DEVEL_FINDREF_DEPTH env variable.
+
+1.2 Sat Apr 26 05:14:58 CEST 2008
+ - apply lots of fixes by Chris Heath.
+ - redo example in manpage, it's complete now.
+
+1.1 Sat Dec 29 22:04:14 CET 2007
+ - ignore weak references.
+ - weaken internal references, to avoid displaying
+ them and drowning important output.
+ - properly find magical references.
+
+1.0 Wed Nov 28 13:19:45 CET 2007
+ - correctly restore RMAGICAL flag (Ruslan Zakirov).
+
+0.2 Wed Feb 7 22:31:58 CET 2007
+ - "backport" to 5.8.8.
+
+0.1 Fri Jan 12 00:06:57 CET 2007
+ - initial release.
+
+0.0 Thu Jan 11 14:21:47 CET 2007
+ - copied from Convert-Scalar.
Added: branches/upstream/libdevel-findref-perl/current/FindRef.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/FindRef.pm?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/FindRef.pm (added)
+++ branches/upstream/libdevel-findref-perl/current/FindRef.pm Tue May 5 23:41:01 2009
@@ -1,0 +1,238 @@
+package Devel::FindRef;
+
+no warnings; # I hate warning nazis
+use strict;
+
+use XSLoader;
+use Scalar::Util;
+
+BEGIN {
+ our $VERSION = '1.4';
+ XSLoader::load __PACKAGE__, $VERSION;
+}
+
+=head1 NAME
+
+Devel::FindRef - where is that reference to my variable hiding?
+
+=head1 SYNOPSIS
+
+ use Devel::FindRef;
+
+ print Devel::FindRef::track \$some_variable;
+
+=head1 DESCRIPTION
+
+Tracking down reference problems (e.g. you expect some object to be
+destroyed, but there are still references to it that keep it alive) can be
+very hard. Fortunately, perl keeps track of all its values, so tracking
+references "backwards" is usually possible.
+
+The C<track> function can help track down some of those references back to
+the variables containing them.
+
+For example, for this fragment:
+
+ package Test;
+
+ use Devel::FindRef;
+ use Scalar::Util;
+
+ our $var = "hi\n";
+ my $global_my = \$var;
+ our %global_hash = (ukukey => \$var);
+ our $global_hashref = { ukukey2 => \$var };
+
+ sub testsub {
+ my $testsub_local = $global_hashref;
+ print Devel::FindRef::track \$var;
+ }
+
+
+ my $closure = sub {
+ my $closure_var = \$_[0];
+ Scalar::Util::weaken (my $weak_ref = \$var);
+ testsub;
+ };
+
+ $closure->($var);
+
+The output is as follows (or similar to this, in case I forget to update
+the manpage after some changes):
+
+ SCALAR(0x7cc888) [refcount 6] is
+ +- referenced by REF(0x8abcc8) [refcount 1], which is
+ | in the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
+ | +- the closure created at tst:18.
+ | +- referenced by REF(0x7d3c58) [refcount 1], which is
+ | | in the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
+ | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is
+ | | | in the global &Test::testsub.
+ | | +- the main body of the program.
+ | +- in the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before.
+ +- referenced by REF(0x7cc7c8) [refcount 1], which is
+ | in the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before.
+ +- in the global $Test::var.
+ +- referenced by REF(0x7cc558) [refcount 1], which is
+ | in the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is
+ | +- referenced by REF(0x8abad0) [refcount 1], which is
+ | | in the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before.
+ | +- referenced by REF(0x8ab4f0) [refcount 1], which is
+ | in the global $Test::global_hashref.
+ +- referenced by REF(0x7ae518) [refcount 1], which is
+ | in the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is
+ | in the global %Test::global_hash.
+ +- referenced by REF(0x7ae2f0) [refcount 1], which is
+ a temporary on the stack.
+
+It is a bit convoluted to read, but basically it says that the value
+stored in C<$var> is referenced by:
+
+=over 4
+
+=item - in the lexical C<$closure_var> (0x8abcc8), which is inside an instantiated
+closure, which in turn is used quite a bit.
+
+=item - in the package-level lexical C<$global_my>.
+
+=item - in the global package variable named C<$Test::var>.
+
+=item - in the hash element C<ukukey2>, in the hash in the my variable
+C<$testsub_local> in the sub C<Test::testsub> and also in the hash
+C<$referenced by Test::hash2>.
+
+=item - in the hash element with key C<ukukey> in the hash stored in
+C<%Test::hash>.
+
+=item - some anonymous mortalised reference on the stack (which is caused
+by calling C<track> with the expression C<\$var>, which creates the
+reference).
+
+=back
+
+And all these account for six reference counts.
+
+
+=head1 EXPORTS
+
+None.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item $string = Devel::FindRef::track $ref[, $depth]
+
+Track the perl value pointed to by C<$ref> up to a depth of C<$depth> and
+return a descriptive string. C<$ref> can point at any perl value, be it
+anonymous sub, hash, array, scalar etc.
+
+This is the function you most often use.
+
+=cut
+
+sub find($);
+
+sub _f($) {
+ "$_[0] [refcount " . (_refcnt $_[0]) . "]"
+}
+
+sub track {
+ my ($ref, $depth) = @_;
+ @_ = ();
+
+ my $buf = "";
+ my %seen;
+
+ Scalar::Util::weaken $ref;
+
+ my $track; $track = sub {
+ my ($refref, $depth, $indent) = @_;
+
+ if ($depth) {
+ my (@about) = find $$refref;
+ if (@about) {
+ for my $about (@about) {
+ $buf .= "$indent" . (@about > 1 ? "+- " : "") . $about->[0];
+ if (@$about > 1) {
+ if ($seen{ref2ptr $about->[1]}++) {
+ $buf .= " " . (_f $about->[1]) . ", which was seen before.\n";
+ } else {
+ $buf .= " " . (_f $about->[1]) . ", which is\n";
+ $track->(\$about->[1], $depth - 1, $about == $about[-1] ? "$indent " : "$indent| ");
+ }
+ } else {
+ $buf .= ".\n";
+ }
+ }
+ } else {
+ $buf .= "$indent not found anywhere I looked :(\n";
+ }
+ } else {
+ $buf .= "$indent not referenced within the search depth.\n";
+ }
+ };
+
+ $buf .= (_f $ref) . " is\n";
+ $track->(\$ref, $depth || $ENV{PERL_DEVEL_FINDREF_DEPTH} || 10, "");
+ $buf
+}
+
+=item @references = Devel::FindRef::find $ref
+
+Return arrayrefs that contain [$message, $ref] pairs. The message
+describes what kind of reference was found and the C<$ref> is the
+reference itself, which can be omitted if C<find> decided to end the
+search. The returned references are all weak references.
+
+The C<track> function uses this to find references to the value you are
+interested in and recurses on the returned references.
+
+=cut
+
+sub find($) {
+ my ($about, $excl) = &find_;
+ my %excl = map +($_ => undef), @$excl;
+ grep !exists $excl{ref2ptr $_->[1]}, @$about
+}
+
+=item $ref = Devel::FindRef::ptr2ref $integer
+
+Sometimes you know (from debugging output) the address of a perl scalar
+you are interested in (e.g. C<HASH(0x176ff70)>). This function can be used
+to turn the address into a reference to that scalar. It is quite safe to
+call on valid addresses, but extremely dangerous to call on invalid ones.
+
+ # we know that HASH(0x176ff70) exists, so turn it into a hashref:
+ my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
+
+=item $ref = Devel::FindRef::ref2ptr $reference
+
+The opposite of C<ptr2ref>, above: returns the internal address of the
+value pointed to by the passed reference. I<No checks whatsoever will be
+done>, so don't use this.
+
+=back
+
+=head1 ENVIRONMENT VARIABLES
+
+You can set the environment variable C<PERL_DEVEL_FINDREF_DEPTH> to an
+integer to override the default depth in C<track>. If a call explicitly
+specified a depth it is not overridden.
+
+=head1 AUTHOR
+
+Marc Lehmann <pcg at goof.com>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2007, 2008 by Marc Lehmann.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.8 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
+
+1
+
Added: branches/upstream/libdevel-findref-perl/current/FindRef.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/FindRef.xs?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/FindRef.xs (added)
+++ branches/upstream/libdevel-findref-perl/current/FindRef.xs Tue May 5 23:41:01 2009
@@ -1,0 +1,238 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define PERL_VERSION_ATLEAST(a,b,c) \
+ (PERL_REVISION > (a) \
+ || (PERL_REVISION == (a) \
+ && (PERL_VERSION > (b) \
+ || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
+
+#if !PERL_VERSION_ATLEAST (5,8,9)
+# define SVt_LAST 16
+#endif
+
+#if !PERL_VERSION_ATLEAST (5,10,0)
+# define SvPAD_OUR(dummy) 0
+#endif
+
+#define res_pair(text) \
+ do { \
+ AV *av = newAV (); \
+ av_push (av, newSVpv (text, 0)); \
+ if (rmagical) SvRMAGICAL_on (sv); \
+ av_push (av, sv_rvweaken (newRV_inc (sv))); \
+ if (rmagical) SvRMAGICAL_off (sv); \
+ av_push (about, newRV_noinc ((SV *)av)); \
+ } while (0)
+
+#define res_text(text) \
+ do { \
+ AV *av = newAV (); \
+ av_push (av, newSVpv (text, 0)); \
+ av_push (about, newRV_noinc ((SV *)av)); \
+ } while (0)
+
+#define res_gv(sigil) \
+ res_text (form ("in the global %c%s::%.*s", sigil, \
+ HvNAME (GvSTASH (sv)), \
+ GvNAMELEN (sv), \
+ GvNAME (sv) ? GvNAME (sv) : "<anonymous>"))
+
+MODULE = Devel::FindRef PACKAGE = Devel::FindRef
+
+PROTOTYPES: ENABLE
+
+void
+find_ (SV *target_ref)
+ PPCODE:
+{
+ SV *arena, *targ;
+ U32 rmagical;
+ int i;
+ AV *about = newAV ();
+ AV *excl = newAV ();
+
+ if (!SvROK (target_ref))
+ croak ("find expects a reference to a perl value");
+
+ targ = SvRV (target_ref);
+
+ for (arena = PL_sv_arenaroot; arena; arena = SvANY (arena))
+ {
+ UV idx = SvREFCNT (arena);
+
+ /* Remember that the zeroth slot is used as the pointer onwards, so don't
+ include it. */
+ while (--idx > 0)
+ {
+ SV *sv = &arena [idx];
+
+ if (SvTYPE (sv) >= SVt_LAST)
+ continue;
+
+ /* temporarily disable RMAGICAL, it can easily interfere with us */
+ if ((rmagical = SvRMAGICAL (sv)))
+ SvRMAGICAL_off (sv);
+
+ if (SvTYPE (sv) >= SVt_PVMG)
+ {
+ if (SvTYPE (sv) == SVt_PVMG && SvPAD_OUR (sv))
+ {
+ /* I have no clue what this is */
+ /* maybe some placeholder for our variables for eval? */
+ /* it doesn't seem to reference anything, so we should be able to ignore it */
+ }
+ else
+ {
+ MAGIC *mg = SvMAGIC (sv);
+
+ while (mg)
+ {
+ if (mg->mg_obj == targ)
+ res_pair (form ("referenced (in mg_obj) by '%c' type magic attached to", mg->mg_type));
+
+ if ((SV *)mg->mg_ptr == targ && mg->mg_flags & MGf_REFCOUNTED)
+ res_pair (form ("referenced (in mg_ptr) by '%c' type magic attached to", mg->mg_type));
+
+ mg = mg->mg_moremagic;
+ }
+ }
+ }
+
+ if (SvROK (sv))
+ {
+ if (SvRV (sv) == targ && !SvWEAKREF (sv) && sv != target_ref)
+ res_pair ("referenced by");
+ }
+ else
+ switch (SvTYPE (sv))
+ {
+ case SVt_PVAV:
+ if (AvREAL (sv))
+ for (i = AvFILLp (sv) + 1; i--; )
+ if (AvARRAY (sv)[i] == targ)
+ res_pair (form ("in array element %d of", i));
+
+ break;
+
+ case SVt_PVHV:
+ if (hv_iterinit ((HV *)sv))
+ {
+ HE *he;
+
+ while ((he = hv_iternext ((HV *)sv)))
+ if (HeVAL (he) == targ)
+ res_pair (form ("in the member '%.*s' of", HeKLEN (he), HeKEY (he)));
+ }
+
+ break;
+
+ case SVt_PVCV:
+ {
+ int depth = CvDEPTH (sv);
+
+ /* Anonymous subs have a padlist but zero depth */
+ if (CvANON (sv) && !depth && CvPADLIST (sv))
+ depth = 1;
+
+ if (depth)
+ {
+ AV *padlist = CvPADLIST (sv);
+
+ while (depth)
+ {
+ AV *pad = (AV *)AvARRAY (padlist)[depth];
+
+ av_push (excl, newSVuv (PTR2UV (pad))); /* exclude pads themselves from being found */
+
+ /* The 0th pad slot is @_ */
+ if (AvARRAY (pad)[0] == targ)
+ res_pair ("the argument array for");
+
+ for (i = AvFILLp (pad) + 1; --i; )
+ if (AvARRAY (pad)[i] == targ)
+ {
+ /* Values from constant functions are stored in the pad without any name */
+ SV *name_sv = AvARRAY (AvARRAY (padlist)[0])[i];
+
+ if (name_sv && SvPOK (name_sv))
+ res_pair (form ("in the lexical '%s' in", SvPVX (name_sv)));
+ else
+ res_pair ("in an unnamed lexical in");
+ }
+
+ --depth;
+ }
+ }
+
+ if (CvCONST (sv) && (SV*)CvXSUBANY (sv).any_ptr == targ)
+ res_pair ("the constant value of");
+
+ if (!CvWEAKOUTSIDE (sv) && (SV*)CvOUTSIDE (sv) == targ)
+ res_pair ("the containing scope for");
+
+ if (sv == targ && CvANON (sv))
+ if (CvSTART (sv)
+ && CvSTART (sv)->op_type == OP_NEXTSTATE
+ && CopLINE ((COP *)CvSTART (sv)))
+ res_text (form ("the closure created at %s:%d",
+ CopFILE ((COP *)CvSTART (sv)) ? CopFILE ((COP *)CvSTART (sv)) : "<unknown>",
+ CopLINE ((COP *)CvSTART (sv))));
+ else
+ res_text (form ("the closure created somewhere in file %s (PLEASE REPORT!)",
+ CvFILE (sv) ? CvFILE (sv) : "<unknown>"));
+ }
+
+ break;
+
+ case SVt_PVGV:
+ if (GvGP (sv))
+ {
+ if (GvSV (sv) == (SV *)targ) res_gv ('$');
+ if (GvAV (sv) == (AV *)targ) res_gv ('@');
+ if (GvHV (sv) == (HV *)targ) res_gv ('%');
+ if (GvCV (sv) == (CV *)targ) res_gv ('&');
+ }
+
+ break;
+ }
+
+ if (rmagical)
+ SvRMAGICAL_on (sv);
+ }
+ }
+
+ /* look at the mortalise stack of the current coroutine */
+ for (i = 0; i <= PL_tmps_ix; ++i)
+ if (PL_tmps_stack [i] == targ)
+ res_text ("a temporary on the stack");
+
+ if (targ == (SV*)PL_main_cv)
+ res_text ("the main body of the program");
+
+ EXTEND (SP, 2);
+ PUSHs (sv_2mortal (newRV_noinc ((SV *)about)));
+ PUSHs (sv_2mortal (newRV_noinc ((SV *)excl)));
+}
+
+SV *
+ptr2ref (UV ptr)
+ CODE:
+ RETVAL = newRV_inc (INT2PTR (SV *, ptr));
+ OUTPUT:
+ RETVAL
+
+UV
+ref2ptr (SV *rv)
+ CODE:
+ RETVAL = PTR2UV (SvRV (rv));
+ OUTPUT:
+ RETVAL
+
+U32
+_refcnt (SV *rv)
+ CODE:
+ RETVAL = SvREFCNT (SvRV (rv));
+ OUTPUT:
+ RETVAL
Added: branches/upstream/libdevel-findref-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/MANIFEST?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/MANIFEST (added)
+++ branches/upstream/libdevel-findref-perl/current/MANIFEST Tue May 5 23:41:01 2009
@@ -1,0 +1,9 @@
+COPYING
+Changes
+Makefile.PL
+MANIFEST
+README
+FindRef.xs
+FindRef.pm
+t/00_load.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libdevel-findref-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/META.yml?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/META.yml (added)
+++ branches/upstream/libdevel-findref-perl/current/META.yml Tue May 5 23:41:01 2009
@@ -1,0 +1,12 @@
+--- #YAML:1.0
+name: Devel-FindRef
+version: 1.4
+abstract: ~
+license: ~
+author: ~
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Added: branches/upstream/libdevel-findref-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/Makefile.PL?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/Makefile.PL (added)
+++ branches/upstream/libdevel-findref-perl/current/Makefile.PL Tue May 5 23:41:01 2009
@@ -1,0 +1,14 @@
+use ExtUtils::MakeMaker;
+
+use 5.008;
+
+WriteMakefile(
+ dist => {
+ PREOP => 'pod2text FindRef.pm | tee README >$(DISTVNAME)/README; chmod -R u=rwX,go=rX . ;',
+ COMPRESS => 'gzip -9v',
+ SUFFIX => '.gz',
+ },
+ NAME => "Devel::FindRef",
+ VERSION_FROM => "FindRef.pm",
+);
+
Added: branches/upstream/libdevel-findref-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/README?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/README (added)
+++ branches/upstream/libdevel-findref-perl/current/README Tue May 5 23:41:01 2009
@@ -1,0 +1,139 @@
+NAME
+ Devel::FindRef - where is that reference to my variable hiding?
+
+SYNOPSIS
+ use Devel::FindRef;
+
+ print Devel::FindRef::track \$some_variable;
+
+DESCRIPTION
+ Tracking down reference problems (e.g. you expect some object to be
+ destroyed, but there are still references to it that keep it alive) can
+ be very hard. Fortunately, perl keeps track of all its values, so
+ tracking references "backwards" is usually possible.
+
+ The "track" function can help track down some of those references back
+ to the variables containing them.
+
+ For example, for this fragment:
+
+ package Test;
+
+ use Devel::FindRef;
+ use Scalar::Util;
+
+ our $var = "hi\n";
+ my $global_my = \$var;
+ our %global_hash = (ukukey => \$var);
+ our $global_hashref = { ukukey2 => \$var };
+
+ sub testsub {
+ my $testsub_local = $global_hashref;
+ print Devel::FindRef::track \$var;
+ }
+
+
+ my $closure = sub {
+ my $closure_var = \$_[0];
+ Scalar::Util::weaken (my $weak_ref = \$var);
+ testsub;
+ };
+
+ $closure->($var);
+
+ The output is as follows (or similar to this, in case I forget to update
+ the manpage after some changes):
+
+ SCALAR(0x7cc888) [refcount 6] is
+ +- referenced by REF(0x8abcc8) [refcount 1], which is
+ | in the lexical '$closure_var' in CODE(0x8abc50) [refcount 4], which is
+ | +- the closure created at tst:18.
+ | +- referenced by REF(0x7d3c58) [refcount 1], which is
+ | | in the lexical '$closure' in CODE(0x7ae530) [refcount 2], which is
+ | | +- the containing scope for CODE(0x8ab430) [refcount 3], which is
+ | | | in the global &Test::testsub.
+ | | +- the main body of the program.
+ | +- in the lexical '&' in CODE(0x7ae530) [refcount 2], which was seen before.
+ +- referenced by REF(0x7cc7c8) [refcount 1], which is
+ | in the lexical '$global_my' in CODE(0x7ae530) [refcount 2], which was seen before.
+ +- in the global $Test::var.
+ +- referenced by REF(0x7cc558) [refcount 1], which is
+ | in the member 'ukukey2' of HASH(0x7ae140) [refcount 2], which is
+ | +- referenced by REF(0x8abad0) [refcount 1], which is
+ | | in the lexical '$testsub_local' in CODE(0x8ab430) [refcount 3], which was seen before.
+ | +- referenced by REF(0x8ab4f0) [refcount 1], which is
+ | in the global $Test::global_hashref.
+ +- referenced by REF(0x7ae518) [refcount 1], which is
+ | in the member 'ukukey' of HASH(0x7d3bb0) [refcount 1], which is
+ | in the global %Test::global_hash.
+ +- referenced by REF(0x7ae2f0) [refcount 1], which is
+ a temporary on the stack.
+
+ It is a bit convoluted to read, but basically it says that the value
+ stored in $var is referenced by:
+
+ - in the lexical $closure_var (0x8abcc8), which is inside an
+ instantiated closure, which in turn is used quite a bit.
+ - in the package-level lexical $global_my.
+ - in the global package variable named $Test::var.
+ - in the hash element "ukukey2", in the hash in the my variable
+ $testsub_local in the sub "Test::testsub" and also in the hash
+ "$referenced by Test::hash2".
+ - in the hash element with key "ukukey" in the hash stored in
+ %Test::hash.
+ - some anonymous mortalised reference on the stack (which is caused by
+ calling "track" with the expression "\$var", which creates the
+ reference).
+
+ And all these account for six reference counts.
+
+EXPORTS
+ None.
+
+FUNCTIONS
+ $string = Devel::FindRef::track $ref[, $depth]
+ Track the perl value pointed to by $ref up to a depth of $depth and
+ return a descriptive string. $ref can point at any perl value, be it
+ anonymous sub, hash, array, scalar etc.
+
+ This is the function you most often use.
+
+ @references = Devel::FindRef::find $ref
+ Return arrayrefs that contain [$message, $ref] pairs. The message
+ describes what kind of reference was found and the $ref is the
+ reference itself, which can be omitted if "find" decided to end the
+ search. The returned references are all weak references.
+
+ The "track" function uses this to find references to the value you
+ are interested in and recurses on the returned references.
+
+ $ref = Devel::FindRef::ptr2ref $integer
+ Sometimes you know (from debugging output) the address of a perl
+ scalar you are interested in (e.g. "HASH(0x176ff70)"). This function
+ can be used to turn the address into a reference to that scalar. It
+ is quite safe to call on valid addresses, but extremely dangerous to
+ call on invalid ones.
+
+ # we know that HASH(0x176ff70) exists, so turn it into a hashref:
+ my $ref_to_hash = Devel::FindRef::ptr2ref 0x176ff70;
+
+ $ref = Devel::FindRef::ref2ptr $reference
+ The opposite of "ptr2ref", above: returns the internal address of
+ the value pointed to by the passed reference. *No checks whatsoever
+ will be done*, so don't use this.
+
+ENVIRONMENT VARIABLES
+ You can set the environment variable "PERL_DEVEL_FINDREF_DEPTH" to an
+ integer to override the default depth in "track". If a call explicitly
+ specified a depth it is not overridden.
+
+AUTHOR
+ Marc Lehmann <pcg at goof.com>.
+
+COPYRIGHT AND LICENSE
+ Copyright (C) 2007, 2008 by Marc Lehmann.
+
+ This library is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself, either Perl version 5.8.8 or, at
+ your option, any later version of Perl 5 you may have available.
+
Added: branches/upstream/libdevel-findref-perl/current/t/00_load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdevel-findref-perl/current/t/00_load.t?rev=34814&op=file
==============================================================================
--- branches/upstream/libdevel-findref-perl/current/t/00_load.t (added)
+++ branches/upstream/libdevel-findref-perl/current/t/00_load.t Tue May 5 23:41:01 2009
@@ -1,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Devel::FindRef;
+$loaded = 1;
+print "ok 1\n";
More information about the Pkg-perl-cvs-commits
mailing list