Detecting declared package variables in perl

Given

# p开发者_如何学编程ackage main;
our $f;
sub f{}
sub g {}
1;

How can I determine that $f, but not $g, has been declared? Off the cuff, I'd thought that *{main::g}{SCALAR} might be undefined, but it is a bona fide SCALAR ref.

Background: I'd like to import a variable into main::, but carp or croak if that variable is already declared.

EDIT Added an f subroutine in response to @DVK's initial answer.

ANSWER (2010-07-27)

This isn't easy, but it is possible.

An eval technique is most portable, working on perls older than 5.10. In more recent perls, introspective modules like Devel::Peek and B can discriminate.

SUMMARY

At this point, after fairly extensive research, I am of a firm opinion that in a situation when a symbol table entry with the name "X" was declared but not assigned to, it is impossible to generically distinguish which of the reference types in a glob was actually declared witout using deep probing of Devel:: stuff.

In other words, you can tell only the following 2 distinct situations:

1. X was not declared at all (symbol table entry does not exist)

2. X was declared and some of the glob types were actually assigned to.

   In this second case,

   • You can find WHICH of the glob types were assigned to and which were not

   • BUT, you can not figure out which of the non-assigned-to glob types were declared-and-unassigned vs. which were not declared at all.

   In other words, for our $f = 1; our @f;; we can tell that $main::f is a scalar; but we can NOT tell whether @f and %f were declared or not - it is not distinguishable at all from our $f = 1; our %f; .

   Please note that the subroutine definitions follow this second rule as well, but declaring a named sub automatically assigns it a value (the code block), so you can never have a sub name in a "declared but not assigned to" state (caveat: might not be true for prototypes??? no clue).

ORIGINAL ANSWER

Well, very limited (and IMHO somewhat fragile) solution to distinguishing a scalar from a subroutine could be to use UNIVERSAL::can:

use strict; 
our $f; 
sub g {};
foreach my $n ("f","g","h") {
    # First off, check if we are in main:: namespace, 
    # and if we are, that we are a scalar
    no strict "refs"; 
    next unless exists $main::{$n} && *{"main::$n"}; 
    use strict "refs"; 
    # Now, we are a declared scalr, unless we are a executable subroutine:
    print "Declared: \$$n\n" unless UNIVERSAL::can("main",$n)
}

Result:

Declared: $f

Please note that {SCALAR} does not seem to work to weed out non-scalars in my testing - it happily passed through @A and %H if I declared them and added to the loop.

UPDATE

I tried brian d foy's approach from Chapter 8 of "Mastering perl" and somehow was unable to get it to work for scalars, hashes or arrays; but as noted below by draegtun it works for subroutines or for variables that were assigned to already:

> perl5.8 -we '{use strict; use Data::Dumper; 
  our $f; sub g {}; our @A=(); sub B{}; our $B; our %H=();
  foreach my $n ("f","g","h","STDOUT","A","H","B") {
      no strict "refs"; 
      next unless exists $main::{$n};
      print "Exists: $n\n";
      if ( defined ${$n}) { print "Defined scalar: $n\n"}; 
      if ( defined @{$n}) { print "Defined ARRAY: $n\n"}; 
      if ( defined %{$n}) { print "Defined HASH: $n\n"}; 
      if ( defined &{$n}) { print "Defined SUB: $n\n"}; 
      use strict "refs";}}'       

Exists: f
Exists: g
Defined SUB: g           <===== No other defined prints worked
Exists: STDOUT
Exists: A
Exists: H
Exists: B
Defined SUB: B           <===== No other defined prints worked

Older perls (pre-5.10) will always have something in the scalar slot.

On newer perls, it appears that the old behavior is mimicked when you try to do *FOO{SCALAR}.

You can use the B introspection module to check the scalar slot, though:

# package main;
our $f;
sub f {}
sub g {}

use B;
use 5.010;
if ( ${ B::svref_2object(\*f)->SV } ) {
   say "f: Thar be a scalar tharrr!";
}
if ( ${ B::svref_2object(\*g)->SV } ) {
   say "g: Thar be a scalar tharrr!";
}

1;

I gave it my best, even going so far as trying to ask eval STRING whether $main::f had been declared via our or my. (This required duping, closing, and later restoring STDERR to cut down on the chattiness.) Once you've changed packages, those declarations no longer seem visible on a temporary switchback.

The technique below will detect whether $f has been declared via

use vars qw/ $f /;

Code below:

package MyModule;

use warnings;
use strict;

# using $f will confuse the compiler, generating
# warnings of 'Variable "%f" is not available'
# although we're going for $main::f
my $__f = "from MyModule";

my %IMPORT_OK = (
  '$f' => [f => \$__f],
);

sub import {
  my($pkg,@imports) = @_;
  my $callpkg = caller;

  die "I don't speak your dirty Pig-Latin"
    if $callpkg !~ /\A\w+(::\w+)*\z/ ||
       grep !/\A[\$@%]\w+\z/, @imports;

  foreach my $name (@imports) {
    my($sym,$ref) = @{ $IMPORT_OK{$name} || [] };
    die "unknown import: $name" unless $sym;

    open my $saverr, ">&", \*STDERR or die "dup STDERR: $!";
    close STDERR;

    my $declared = eval qq{
      package $callpkg;
      my(undef)=$name;
      1;
    };

    open STDERR, ">&", $saverr or print "restore STDERR: $!";
    die "${callpkg}::$sym already exists" if $declared;

    {
      no strict 'refs';
      *{$callpkg . "::" . $sym} = $ref;
    }
  }
}

1;

You can check for a defined subroutine like so:

say 'g() defined in main' if defined &{'main::g'};

Unfortunately the same method only works on package variable if a value has been assigned:

our $f = 1;
say '$f defined with value in main' if defined ${'main::f'};

/I3az/

Devel::Peek appears to be able to distinguish between used and unused things in the SCALAR slot:

use strict;
use warnings;
use Devel::Peek;

our $f;
sub f { }
sub g { }

Dump(*f);
Dump(*g);

The output is:

SV = PVGV(0x187360c) at 0x182c0f4
  REFCNT = 3
  FLAGS = (MULTI,IN_PAD)
  NAME = "f"
  NAMELEN = 1
  GvSTASH = 0x24a084    "main"
  GP = 0x1874bd4
    SV = 0x182c0a4
    REFCNT = 1
    IO = 0x0
    FORM = 0x0  
    AV = 0x0
    HV = 0x0
    CV = 0x24a234
    CVGEN = 0x0
    LINE = 6
    FILE = "c:\temp\foo.pl"
    FLAGS = 0xa
    EGV = 0x182c0f4 "f"
SV = PVGV(0x187362c) at 0x18514dc
  REFCNT = 2
  FLAGS = (MULTI,IN_PAD)
  NAME = "g"
  NAMELEN = 1
  GvSTASH = 0x24a084    "main"
  GP = 0x1874cbc
    SV = 0x0
    REFCNT = 1
    IO = 0x0
    FORM = 0x0  
    AV = 0x0
    HV = 0x0
    CV = 0x1865234
    CVGEN = 0x0
    LINE = 8
    FILE = "c:\temp\foo.pl"
    FLAGS = 0xa
    EGV = 0x18514dc "g"

The lines of interest are under the GP = section, specifically SV, AV, HV, and CV (scalar, array, hash, and code, respectively). Note that the dump of *g shows SV = 0x0. Unfortunately, there doesn't appear to be a programmatic way to get this information. A blunt instrument approach would be to capture the output of Dump() and parse it.