Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.

Programmatic Discovery of Package Variables in Perl? 6 Comments More | Login | Reply /

 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • PadWalker can see both lexical and package variables, just fill %pad_vars with peek_our first and let peek_my override it (since lexical variables hide package variables).

    • This works for vars.pm and $Fully::Qualified::Variables too?

      • 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).

        • 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.

          • 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 );
            }

            • 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.

Stories, comments, journals, and other submissions on use Perl; are Copyright 1998-2006, their respective owners.