PadWalker
view release on metacpan or search on metacpan
Revision history for Perl extension PadWalker.
0.01 Thu Nov 9 12:58:10 2000
- original version; created by h2xs 1.19
Revision history between 0.01 and 0.03 has been lost in the mists
of time. Sorry about that.
0.03 was the first public release.
0.04 Thu Jul 19 13:50:19 BST 2001
0.13 Mon Oct 3 11:54:23 BST 2005
- don't build a debugging build unless explicitly told to!
0.14 Thu Oct 6 17:19:06 BST 2005
- Fix the bugs reported by Dave Mitchell:
o if one variable masks another, make sure we return the
appropriate one;
o for a variable whose value has been lost, return undef
rather than the name of the variable;
o Don't die if PadWalker is called from a closure whose
containing scope has disappeared.
0.99 Fri Oct 7 17:23:09 BST 2005
- Make peek_sub return the values, if possible,
even when it's not in the call chain;
- Allow an our variable to mask a my variable,
and vice versa;
- Add peek_our and closed_over routines.
0.99_91 Thu Oct 13 17:35:11 BST 2005
1.1 Sun Oct 22 16:13:40 BST 2006
- Accommodate change 27312 "Store the stash for our in magic slot"
(See http://www.mail-archive.com/perl5-changes@perl.org/msg14073.html
or http://public.activestate.com/cgi-bin/perlbrowse/27312)
See also http://public.activestate.com/cgi-bin/perlbrowse/27306
1.2 Thu Nov 16 22:33:27 GMT 2006
- Change prerequisites to accurately reflect versions of Perl that
PadWalker actually works with (i.e. 5.8.2 or later).
- Fix memory leak: thanks to Rocco Caputo
1.3 Tue Jan 2 23:10:35 GMT 2007
- Accommodate changes 29629-29630 "Move the low/high cop sequences
from NVX/IVX to a two U32 structure".
1.4 Fri Jan 5 09:12:11 GMT 2007
- Accommodate change 29679 "Rename OURSTASH to SvOURSTASH and
OURSTASH_set to SvOURSTASH_set". (Dear Nick, please stop
breaking PadWalker. kthxbye.)
1.5 Fri Jan 5 16:22:27 GMT 2007
- Fix egregrious bug in 1.4 :-(
1.6 Mon Jan 14 10:48:09 GMT 2008
- Make _upcontext work in 64-bit architectures.
(http://rt.cpan.org/Ticket/Display.html?id=32287)
Thanks to Niko Tyni.
1.7 Mon Feb 4 09:56:31 GMT 2008
1.8 Thu 25 Jun 2009 21:17:17 BST
- Apply patches from doy (#41710) and nothingmuch (set_closed_over).
1.9 Fri 26 Jun 2009 10:01:17 BST
- Identical to 1.8, but with the bogus metadata ._ files removed
from the distributed tar file.
1.91 Wed 14 Jul 2010 01:07:05 BST
- Incorporate patches from Florian Ragwitz and Yuval Kogman
(see http://github.com/robinhouston/PadWalker/commits/master)
1.92 Thu 15 Jul 2010 17:05:05 BST
- Remove "Jobsian dot file cruft" reported by Steve Mynott.
- Incorporate patch from Fuji, Goro, correcting earlier patch from Yuval Kogman.
1.93 Sun 5 Feb 2012 15:52:57 GMT
- Correct the version number in META.yml
(https://rt.cpan.org/Ticket/Display.html?id=59459)
Do this by using MakeMaker to auto-generate META.yml, to prevent
similar problems in future. This is possible because the new
1.99 Tue 11 Nov 2014 15:01:37 CET
- Make it compatible with bleadperl.
Patch from Father Chrysostomous at https://rt.cpan.org/Public/Bug/Display.html?id=100262
1.99_1 Tue 11 Nov 2014 19:38:17 CET
- Restore compatibility with perl 5.8
Patch from paul@city-fan.org at https://rt.cpan.org/Public/Bug/Display.html?id=100262#txn-1431869
2.0 Mon 8 Dec 2014 13:45:37 GMT
- Restore compatibility with bleadperl
Patch from Dagfinn Ilmari Mannsåker at https://github.com/robinhouston/PadWalker/pull/3
2.1 Fri 24 Apr 2015 20:29:12 BST
- Another bleadperl fix
https://rt.cpan.org/Public/Bug/Display.html?id=101037
2.2 Fri 23 Oct 2015 17:55:31 BST
- Convert to PERL_NO_GET_CONTEXT
https://github.com/robinhouston/PadWalker/pull/2
2.3 Fri 10 Nov 2017 18:26:29 GMT
- Make tests work with -Ddefault_inc_excludes_dot
https://rt.cpan.org/Public/Bug/Display.html?id=120421
2.4 Sat 26 Sep 2020 18:39:17 BST
- Names of utf8 lexical vars not reported correctly
https://rt.cpan.org/Ticket/Display.html?id=133424
2.5 Sun 27 Sep 2020 13:22:11 BST
Changes
Makefile.PL
MANIFEST
PadWalker.xs
PadWalker.pm
README
t/bar.pl
t/baz.pl
t/closure.t
t/dm.t
t/foo.t
t/our.t
t/recurse.t
t/sub.t
t/test.t
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "PadWalker",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: PadWalker
no_index:
directory:
- t
- inc
requires:
perl: 5.008001
version: 2.5
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
use strict;
require 5.008001;
# Remember (like I didn't) that WriteMakefile looks at @ARGV,
# so an alternative way to configure a debugging build is:
# perl Makefile.PL DEFINE=-DPADWALKER_DEBUGGING.
my $DEBUGGING = '';
if (@ARGV && $ARGV[0] eq '-d') {
warn "Configuring a debugging build of PadWalker\n";
print STDERR <<END;
************************************************************************
* WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! WARNING! *
************************************************************************
You are building PadWalker in debugging mode, which causes it to
print a lot of gnomic information about its internal operation.
The test suite will fail, because this information will confuse
the test harness. You almost certainly do *not* want to do this
unless you're the author of PadWalker (or perhaps just irrepressibly
curious about its internal operation).
END
$DEBUGGING = '-DPADWALKER_DEBUGGING';
shift;
}
WriteMakefile(
'NAME' => 'PadWalker',
'VERSION_FROM' => 'PadWalker.pm', # finds $VERSION
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => $DEBUGGING,
'INC' => '', # e.g., '-I/usr/include/other',
($DEBUGGING ? (CCFLAGS => '-Wall -ansi') : ()),
dist => {TAR => 'env COPYFILE_DISABLE=true tar'},
MIN_PERL_VERSION => "5.008001",
);
PadWalker.pm view on Meta::CPAN
package PadWalker;
use strict;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
require Exporter;
require DynaLoader;
require 5.008;
@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw(peek_my peek_our closed_over peek_sub var_name set_closed_over);
%EXPORT_TAGS = (all => \@EXPORT_OK);
$VERSION = '2.5';
bootstrap PadWalker $VERSION;
sub peek_my;
sub peek_our;
sub closed_over;
sub peek_sub;
sub var_name;
1;
__END__
=head1 NAME
PadWalker - play with other peoples' lexical variables
=head1 SYNOPSIS
use PadWalker qw(peek_my peek_our peek_sub closed_over);
...
=head1 DESCRIPTION
PadWalker is a module which allows you to inspect (and even change!)
lexical variables in any subroutine which called you. It will only
show those variables which are in scope at the point of the call.
PadWalker is particularly useful for debugging. It's even
used by Perl's built-in debugger. (It can also be used
for evil, of course.)
I wouldn't recommend using PadWalker directly in production
code, but it's your call. Some of the modules that use
PadWalker internally are certainly safe for and useful
in production.
=over 4
=item peek_my LEVEL
=item peek_our LEVEL
The LEVEL argument is interpreted just like the argument to C<caller>.
So C<peek_my(0)> returns a reference to a hash of all the C<my>
PadWalker.xs view on Meta::CPAN
strcpy(qualified_name, package_name);
strcat(qualified_name, "::");
strcat(qualified_name, name_str+1);
debug_print(("fetch_from_stash: Looking for %c%s\n",
name_str[0], qualified_name));
switch (name_str[0]) {
case '$': ret = get_sv(qualified_name, FALSE); break;
case '@': ret = (SV*) get_av(qualified_name, FALSE); break;
case '%': ret = (SV*) get_hv(qualified_name, FALSE); break;
default: die("PadWalker: variable '%s' of unknown type", name_str);
}
if (ret)
debug_print(("%s\n", sv_peek(ret)));
else
/* I don't _think_ this should ever happen */
debug_print(("XXXX - Variable %c%s not found\n",
name_str[0], qualified_name));
Safefree(qualified_name);
return ret;
}
PadWalker.xs view on Meta::CPAN
padlist_into_hash(pTHX_ PADLIST* padlist, HV* my_hash, HV* our_hash,
U32 valid_at_seq, long depth)
{
PADNAMELIST *pad_namelist;
PAD *pad_vallist;
if (depth == 0) depth = 1;
if (!padlist) {
/* Probably an XSUB */
die("PadWalker: cv has no padlist");
}
pad_namelist = PadlistNAMES(padlist);
pad_vallist = PadlistARRAY(padlist)[depth];
pads_into_hash(aTHX_ pad_namelist, pad_vallist, my_hash, our_hash, valid_at_seq);
}
void
context_vars(pTHX_ PERL_CONTEXT *cx, HV* my_ret, HV* our_ret, U32 seq, CV *cv)
{
PadWalker.xs view on Meta::CPAN
cop->cop_seq, ccstack[i].blk_eval.cv);
return;
/* If it's OP_ENTERTRY, we skip this altogether. */
}
break;
case CXt_SUB:
#ifdef CXt_FORMAT
case CXt_FORMAT:
#endif
Perl_die(aTHX_ "PadWalker: internal error");
exit(EXIT_FAILURE);
}
}
}
void
get_closed_over(pTHX_ CV *cv, HV *hash, HV *indices)
{
I32 i;
U32 val_depth;
PadWalker.xs view on Meta::CPAN
STATIC bool
is_correct_type(SV *orig, SV *restore) {
return (
( SvTYPE(orig) == SvTYPE(restore) )
||
( is_scalar_type(orig) && is_scalar_type(restore) )
);
}
MODULE = PadWalker PACKAGE = PadWalker
PROTOTYPES: DISABLE
void
peek_my(uplevel)
I32 uplevel;
PREINIT:
HV* ret = newHV();
HV* ignore = newHV();
PPCODE:
do_peek(aTHX_ uplevel, ret, ignore);
PadWalker.xs view on Meta::CPAN
void
peek_sub(cv)
CV* cv;
PREINIT:
HV* ret = newHV();
HV* ignore = newHV();
PPCODE:
if (CvISXSUB(cv))
die("PadWalker: cv has no padlist");
padlist_into_hash(aTHX_ CvPADLIST(cv), ret, ignore, 0, CvDEPTH(cv));
SvREFCNT_dec((SV*) ignore);
EXTEND(SP, 1);
PUSHs(sv_2mortal(newRV_noinc((SV*)ret)));
void
set_closed_over(sv, pad)
SV* sv;
HV* pad;
PREINIT:
PadWalker.xs view on Meta::CPAN
}
char*
var_name(sub, var_ref)
SV* sub;
SV* var_ref;
PREINIT:
SV *cv;
CODE:
if (!SvROK(var_ref))
croak("Usage: PadWalker::var_name(sub, var_ref)");
if (SvROK(sub)) {
cv = SvRV(sub);
if (SvTYPE(cv) != SVt_PVCV)
croak("PadWalker::var_name: sub is neither a CODE reference nor a number");
} else
cv = (SV *) up_cv(aTHX_ SvIV(sub), "PadWalker::upcontext");
RETVAL = get_var_name((CV *) cv, SvRV(var_ref));
OUTPUT:
RETVAL
void
_upcontext(uplevel)
I32 uplevel
PPCODE:
/* This is used by Devel::Caller. */
-----------------------------------------------------------------------------
| PadWalker v2.5 - Robin Houston
-----------------------------------------------------------------------------
NAME
PadWalker - play with other peoples' lexical variables
SYNOPSIS
use PadWalker qw(peek_my peek_our peek_sub closed_over);
...
DESCRIPTION
PadWalker is a module which allows you to inspect (and even change!)
lexical variables in any subroutine which called you. It will only show
those variables which are in scope at the point of the call.
PadWalker is particularly useful for debugging. It's even used by
Perl's built-in debugger. (It can also be used for evil, of course.)
I wouldn't recommend using PadWalker directly in production code, but
it's your call. Some of the modules that use PadWalker internally are
certainly safe for and useful in production.
peek_my LEVEL
peek_our LEVEL
The LEVEL argument is interpreted just like the argument to
"caller". So peek_my(0) returns a reference to a hash of all the
"my" variables that are currently in scope; peek_my(1) returns a
reference to a hash of all the "my" variables that are in scope at
the point where the current sub was called, and so on.
t/closure.t view on Meta::CPAN
use strict; use warnings;
use PadWalker 'closed_over', 'set_closed_over';
print "1..30\n";
my $x=2;
my $h = closed_over (my $sub = sub {my $y = $x++});
my @keys = keys %$h;
print (@keys == 1 ? "ok 1\n" : "not ok 1\n");
print (${$h->{'$x'}} eq 2 ? "ok 2\n" : "not ok 2\n");
use strict; use warnings;
use PadWalker;
# All these bugs were reported by Dave Mitchell; he's the first
# person to get his very own test script.
print "1..8\n";
# Does PadWalker work if it's called from a closure?
sub f {
my $x = shift;
sub {
my $t = shift;
my $x_val = ${PadWalker::peek_my(0)->{'$x'}};
print ($x_val eq $x ? "ok $t\n" : "not ok $t # $x_val\n");
}
}
f(6)->(1);
# Even if the sub 'f' has been blown away?
my $f = f('eh?');
undef &f;
$f->(2);
# If there's no reference to the value, we expect to get undef;
# if there is, we expect to get the value.
sub h {
my $x = my $y = 'fixed';
sub {
my $vals = PadWalker::peek_my(0);
my $x_ref = $vals->{'$x'};
my $y_ref = $vals->{'$y'};
# There is a difference in behaviour between different versions
# of Perl here. Since a0d2bbd5c47035a4f7369e4fddd46b502764d86e
# we don’t see unclosed variables in the pad at all.
print (!defined($x_ref)||!defined($$x_ref) ? "ok 3\n" : "not ok 3 # $x_ref\n");
print (defined($y_ref) ? "ok 4\n" : "not ok 4\n");
print ($$y_ref eq 'fixed' ? "ok 5\n" : "not ok 5 # $$y_ref\n");
my $unused = $y;
}
}
h()->();
# How well do we cope with one variable masking another?
my $x = 1;
sub g {
my $x = 2;
my $v_x = ${PadWalker::peek_my(0)->{'$x'}};
print ($v_x eq 2 ? "ok 6\n" : "not ok 6 # $v_x\n");
}
g();
no warnings 'misc'; # I know it masks an earlier declaration -
# that's the whole point!
my $x = 'final value';
my $v_x = ${PadWalker::peek_my(0)->{'$x'}};
print ($v_x eq $x ? "ok 7\n" : "not ok 7 # $v_x\n");
# An 'our' variable should mask a 'my':
our $x;
$x = $x; # Stop old perls from giving 'used only once' warning
print (exists PadWalker::peek_my(0)->{'$x'} ? "not ok 8\n" : "ok 8\n");
use strict;
use PadWalker;
use Data::Dumper;
print "1..6\n";
chdir "t";
require "./bar.pl";
do "./baz.pl";
my $nono;
sub foo {
my $inner = "You shouldn't see this one";
PadWalker::peek_my(1);
}
use strict; use warnings;
use PadWalker 'peek_our';
print "1..2\n";
our $x;
our $h;
($x,$h) = (7);
no warnings 'misc'; # Yes, I know it masks an earlier declaration!
my $h;
t/recurse.t view on Meta::CPAN
use strict;
use PadWalker 'peek_my';
print "1..2\n";
sub rec {
my ($arg) = @_;
my $var = 'first';;
if ($arg) {
$var = 'second';
my ($h0, $h1) = map peek_my($_), 0, 1;
print((${$h0->{'$var'}} eq 'second' ? "ok " : "not ok "), "1\n",
use strict; use warnings;
use PadWalker 'peek_sub';
print "1..6\n";
my $t = 0;
sub onlyvars {
my (@initial);
my ($t, $h, @names) = @_;
my %names;
@names{@names} = (1) x @names;
BEGIN { $| = 1; print "1..15\n"; }
END {print "not ok 1\n" unless $loaded;}
use PadWalker;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
our $this_one_shouldnt_be_found;
$this_one_shouldnt_be_found = 12; # quieten warning
sub onlyvars {
my (@initial);
my $outside_var = 12345;
sub foo {
my $variable = 23;
{
my $hmm = 12;
}
#my $hmm = 21;
my $h = PadWalker::peek_my(0);
onlyvars(2, $h, qw'$outside_var $variable');
${$h->{'$variable'}} = 666;
}
sub bar {
local ($t, $l, @v) = @_;
my %x = (1 => 2);
my $y = 9;
onlyvars($t, baz($l), @v);
my @z = qw/not yet visible/;
}
sub baz {
my $baz_var;
return PadWalker::peek_my(shift);
}
foo(); # test 2
bar(3, 1, qw($outside_var $y %x)); # test 3
&{ my @array=qw(fring thrum); sub {bar(4, 2, qw(@array $outside_var));} }; # test 4
() = sub {1};
my $alot_before;
onlyvars(5, PadWalker::peek_my(0), qw($outside_var $alot_before)); # test 5
my $before;
onlyvars(6, baz(1), qw($outside_var $alot_before $before)); # test 6
my $after;
onlyvars(7, baz(0), qw($baz_var $outside_var)); # test 7
sub quux {
my %quux_var;
bar(@_);
$alot_before $before $after $discriminate1)); # test 11
my $too_late;
# This is quite a subtle one: the variable $x is actually FETCHed from inside
# the onlyvars subroutine. The magical scalar is on the stack until line 2 of
# onlyvars. So if we peek back one level from the FETCH, we can see inside
# onlyvars.
tie $x, "blah", 1;
onlyvars(12, $x, qw(@initial)); # test 12
eval q{ PadWalker::peek_my(1) };
print (($@ =~ /^Not nested deeply enough/) ? "ok 13\n" : "not ok 13\n"); # test 13
sub recurse {
my ($i) = @_;
if ($i == 0) {
my $vars = PadWalker::peek_my(2);
my $val = ${$vars->{'$i'}};
print ($val eq "2" ? "ok 14\n" : "not ok 14\t# $val\n");
}
else {
recurse($i - 1);
}
}
recurse(5); # test 14
eval q{
my %e;
onlyvars(15, PadWalker::peek_my(0),
qw($outside_var $x $yyy
$alot_before $before $after $discriminate1 $too_late %e))
}; # test 15
package blah;
sub TIESCALAR { my ($class, $x)=@_; bless \$x }
sub FETCH { my $self = shift; return PadWalker::peek_my($$self) }
use strict;
use PadWalker;
print "1..5\n";
our %h;
my $out1 = 'out1';
my $out2 = 'out2';
sub f1() {
my $local = 'local';
%h = %{PadWalker::peek_my(1)};
print (${$h{'$out1'}} eq 'out1' ? "ok 1\n" : "not ok 1\n");
print (${$h{'$out2'}} eq 'out2' ? "ok 2\n" : "not ok 2\n");
}
f1();
eval q{
my $in_eval = 'in_eval';
eval q{
() = $in_eval;
%h = %{PadWalker::peek_my(0)};
print (exists $h{'$out1'} && ${$h{'$out1'}} eq 'out1'
? "ok 3\n" : "not ok 3\n");
print (exists $h{'$out2'} && ${$h{'$out2'}} eq 'out2'
? "ok 4\n" : "not ok 4\n");
print (exists $h{'$in_eval'} && ${$h{'$in_eval'}} eq 'in_eval'
? "ok 5\n" : "not ok 5\n");
};
die $@ if $@;
};
t/var_name.t view on Meta::CPAN
use PadWalker 'var_name';
use strict;
use warnings;
no warnings 'misc';
chdir "t";
print "1..8\n";
my $foo;
( run in 0.881 second using v1.01-cache-2.11-cpan-05444aca049 )