With Test::Most, you can do something like this:
ok $response = some_func($foo), 'some_func() should return something'
or show $response;
And if the test fails, the show() function should display something like:
# $response = 0;
However, if $response is actually a package variable, you would get:
# $VAR1 = 0;
This is because show relies on Data::Dumper::Names and that, in turn, relies on PadWalker. So basically, I'm wondering how I know something is a package variable and how to (easily) find its name. The only thing which occurs to me offhand is to either programmatically fetch the names of Perl's special variables[1] and see if $VAR1 is really one of those. That might catch many package variables (and other "strange" variables like @_?), but is that enough? When people declare their own package variables, is there any easy way for me to find and identify them short of walking symbol tables looking for them?
1. I've seen this done, but I can't recall how to do it.Re:use peek_our as well
cowens on 2009-04-14T12:18:12
#!/usr/bin/perl
use strict;
use warnings;use PadWalker qw/peek_our peek_my/;
use Scalar::Util 'refaddr';
use Data::Dumper;our $foo = 1;
our $bar = 2;
{
my $foo = 3;
print "my masks our\n", dumper(\$foo, \$bar);
}
print "now both are our\n", dumper(\$foo, \$bar);sub dumper {
my $package = peek_our(1);
my $lexical = peek_my(1);
my %pad_vars;
while ( my ( $var, $ref ) = each %$package ) {# we no longer remove the '$' sigil because we don't want
# "$foo = \@array" reported as "@foo".
$var =~ s/^[\@\%]/*/;
$pad_vars{ refaddr $ref } = $var;
}
while ( my ( $var, $ref ) = each %$lexical ) {# we no longer remove the '$' sigil because we don't want
# "$foo = \@array" reported as "@foo".
$var =~ s/^[\@\%]/*/;
$pad_vars{ refaddr $ref } = $var;
}
my @names;
my $varcount = 1;
foreach (@_) {
my $name;
INNER: foreach ( \$_, $_ ) {
no warnings 'uninitialized';
$name = $pad_vars{ refaddr $_} and last INNER;
}
push @names, $name;
}return Data::Dumper->Dump( \@_, \@names );
}Re:use peek_our as well
cowens on 2009-04-14T17:17:26
This seems to handle $" and the like:
#!/usr/bin/perl
use strict;
use warnings;use PadWalker qw/peek_our peek_my/;
use Scalar::Util 'refaddr';
use Data::Dumper;our $foo = 1;
our $bar = 2;
{
my $foo = 3;
print "my masks our\n", dumper(\$foo, \$bar, \$");
}
print "now both are our\n", dumper(\$foo, \$bar, \$");sub dumper {
my $package = peek_our(1);
my $lexical = peek_my(1);
my %pad_vars;
while ( my ( $var, $ref ) = each %$package ) {# we no longer remove the '$' sigil because we don't want
# "$foo = \@array" reported as "@foo".
$var =~ s/^[\@\%]/*/;
$pad_vars{ refaddr $ref } = $var;
}
foreach my $var (keys %main::) {
my $glob = $main::{$var};if (defined ${$glob}) {
$pad_vars{ refaddr \${$glob} } = "\$$var";
}if (defined @{$glob}) {
$pad_vars{ refaddr \@{$glob} } = $var;
}if (defined %{$glob}) {
$pad_vars{ refaddr \%{$glob} } = $var;
}
}while ( my ( $var, $ref ) = each %$lexical ) {
# we no longer remove the '$' sigil because we don't want
# "$foo = \@array" reported as "@foo".
$var =~ s/^[\@\%]/*/;
$pad_vars{ refaddr $ref } = $var;
}
my @names;
my $varcount = 1;
foreach (@_) {
my $name;
INNER: foreach ( \$_, $_ ) {
no warnings 'uninitialized';
$name = $pad_vars{ refaddr $_} and last INNER;
}
push @names, $name;
}return Data::Dumper->Dump( \@_, \@names );
}Re:use peek_our as well
jjore on 2009-04-14T15:49:02
This works for vars.pm and $Fully::Qualified::Variables too?
Re:use peek_our as well
cowens on 2009-04-14T17:20:45
Yes, but only if they have had a value assigned to them. Otherwise they aren't really variables yet (just compiler directives to not throw errors if it sees them).
Re:use peek_our as well
cowens on 2009-04-14T17:31:22
Well, it handles $main::foo, but not $other::package::foo. You would need to look in %other::package for it. Hmm, there should be some way of finding out what namespaces exist.
Re:use peek_our as well
cowens on 2009-04-14T18:40:02
Alright, it is ugly, but it gets the job done. This handles everything but var pragma variables that have never been assigned to (they don't really exist yet). This version also has the benefit of displaying package and lexical variables differently, so you can easily spot the masking effect. Hmm, but I think there might be a bug in the case where you have
{
our $foo;
{
my $foo;
{
our $foo;
print dumper(\$foo);
}
}
}But I am not sure anything can be done about that.
#!/usr/bin/perl
use strict;
use warnings;use PadWalker qw/peek_our peek_my/;
use Scalar::Util 'refaddr';
use Data::Dumper;use vars qw/$baz $quux/;
$other::package::fork = 0;
our $foo = 1;
our $bar = 2;
$baz = 3;print "now all are package\n", dumper(
\$foo,
\$bar,
\$baz,
\$quux,
\$",
);{
my $foo = 4;
print "\nnow \$foo is masked by a lexical\n", dumper(
\$foo,
\$bar,
\$baz,
\$quux,
\$",
);
}sub find_package_vars {
my ($package, $pad_vars) = @_;
no strict 'refs';
no warnings;
foreach my $name (%{$package}) {
my $pkgname = "${package}$name";
if ($name =~/::/) {
next if $name =~/^\*?main::$/;
find_package_vars($pkgname, $pad_vars);
next;
}my $glob = ${$package}{$name};
if (defined ${$glob}) {
$pad_vars->{ refaddr \${$glob} } = "\$$pkgname";
}#FIXME: there is probably a better way, but I am lazy at the moment
eval {
if (defined @{$glob}) {
$pad_vars->{ refaddr \@{$glob} } = $pkgname;
}
};eval {
if (defined %{$glob}) {
$pad_vars->{ refaddr \%{$glob} } = $pkgname;
}
};
}
}sub dumper {
my %pad_vars;
find_package_vars("main::", \%pad_vars);my $lexical = peek_my(1);
while ( my ( $var, $ref ) = each %$lexical ) {# we no longer remove the '$' sigil because we don't want
# "$foo = \@array" reported as "@foo".
$var =~ s/^[\@\%]/*/;
$pad_vars{ refaddr $ref } = $var;
}
my @names;
my $varcount = 1;
foreach (@_) {
my $name;
INNER: foreach ( \$_, $_ ) {
no warnings 'uninitialized';
$name = $pad_vars{ refaddr $_} and last INNER;
}
push @names, $name;
}return Data::Dumper->Dump( \@_, \@names );
}Re:use peek_our as well
cowens on 2009-04-14T18:51:19
I take it back, since he is using the address of the variable as the key it works fine, and there is the order doesn't matter when you build the hash.