2010-07-26 11 views
8

DadoDetección de variables de paquete declarados en Perl

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

¿Cómo puedo determinar que $f, pero no $g, ha sido declarado? Por el puño, pensé que *{main::g}{SCALAR} podría estar indefinido, pero es bona fide SCALAR ref.

Antecedentes: me gustaría importar una variable en main::, pero carpa o croak si esa variable ya está declarada.

EDIT Agregó una subrutina f en respuesta a la respuesta inicial de @ DVK.

RESPUESTA (2010-07-27)

Esto no es fácil, pero es posible.

Un eval technique es más portátil, funciona en perls anteriores a 5.10. En perls más recientes, los módulos introspectivos como Devel::Peek y B pueden discriminar.

Respuesta

1

lo di todo lo posible, incluso yendo tan lejos como tratando de preguntar si eval STRING$main::f había sido declarada a través de our o my. (Esto requirió duping, closing y posterior restauración de STDERR para reducir el chattiness). Una vez que haya cambiado los paquetes, esas declaraciones ya no se verán en un switchback temporal.

La técnica más adelante detectará si $f se ha declarado a través de

Código
use vars qw/ $f /; 

a continuación:

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[\[email protected]%]\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; 
+0

+1, y normalmente no recomiendo stringish eval() s. :) Este es más o menos mi enfoque actual. Es importante destacar que la comprobación de evaluación aquí * no * invoque un método fetch() d escalar FETCH - que sería No bueno (tm). Me pregunto, ¿podría local() izing $ SIG {__ WARN__} hacerse cargo de los mensajes de error? – pilcrow

+0

Sí, FWIW, en mi prueba si localizas el controlador _ \ _ WARN \ _ \ _ (y $ @, también, por cortesía) antes de la evaluación, silencias los errores sin el descriptor de archivo duppery. – pilcrow

4

RESUMEN

En este punto, después de bastante extensa investigación, soy de una opinión firme que en una situación cuando una entrada de la tabla de símbolos con el nombre de "X" fue declarado pero no asigna a, es imposible distinguir genéricamente cuál de los tipos de referencia en un glob fue realmente declarado sin utilizar el sondeo profundo de Devel :: stuff.

En otras palabras, se puede decir sólo los siguientes 2 situaciones distintas:

  1. X no fue declarado en absoluto (entrada de la tabla de símbolos no existe)

  2. X fue declarado y algunos de los tipos glob en realidad fueron asignados a.

    En este segundo caso,

    • Usted puede encontrar cuál de los tipos glob fueron asignados a y cuáles no

    • PERO, que no puede averiguar cuál de las los tipos glob no asignados a declarados y no asignados frente a los que no se declararon en absoluto.

    En otras palabras, para our $f = 1; our @f;; podemos decir que $main::f es un escalar; pero no podemos decir si @f y %f fueron declarados o no - no es distinguible en absoluto de our $f = 1; our %f;.

    Tenga en cuenta que las definiciones de subrutina siguen esta segunda regla también, pero declarar un sub nombrado automáticamente le asigna un valor (el bloque de código), por lo que nunca puede tener un nombre secundario en "declarado pero no asignado" estado (advertencia: puede no ser cierto para los prototipos ??? no hay pista).

respuesta original

Bueno, muy limitado (y en mi humilde opinión un tanto frágil) solución para distinguir un escalar desde una subrutina podría ser el uso UNIVERSAL :: puede:

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

Resultado :

Declared: $f 

Tenga en cuenta que {SCALAR} no parece funcionar para eliminar los non-escalars en mis pruebas, felizmente pasó a través de @A y %H si los declaro y agregué al ciclo.

ACTUALIZACIÓN

me trataron enfoque Brian D de Foy del Capítulo 8 de "El dominio de Perl" y de alguna manera era capaz de conseguir que funcione para los escalares, hashes o matrices; pero, como se señala más adelante por draegtun funciona para subrutinas o para las variables que les fueron asignados ya:

> 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 
+0

+1 Excelente intento. FWIW, no estoy seguro de que \ * {name} {SCALAR} * sea siempre falso * - es la prueba de existencia (que puede hacerse 'strict'-ly) que omite" h ". Sin embargo, esta comprobación falla si sub f {} también está definido. – pilcrow

+0

@pilcrow - sí, eso es exactamente lo que quise decir en el último párrafo. Y tienes razón sobre '$ f' +' & f' ... como dije, esto era un tanto frágil y limitado. – DVK

+1

@pilcrow @DVK De perlref: "' * foo {THING} 'devuelve' undef' si ese THING en particular no se ha usado aún, excepto en el caso de los escalares. '* Foo {SCALAR}' devuelve una referencia a un escalar anónimo si '$ foo' aún no se ha usado. Esto podría cambiar en una versión futura." Esto hace '& main :: f' contra' $ main :: f' un caso confuso. –

0

Puede comprobar si hay una subrutina define así:

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

Desgraciadamente, sólo el mismo método funciona en variable de paquete si se ha asignado un valor:

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

/I3az/

1

Devel :: Peek parece ser capaz de distinguir entre cosas usados ​​y no usados ​​en la ranura ESCALAR:

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

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

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

La salida es:

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" 

Las líneas de interés están bajo la sección GP = , específicamente SV, AV, HV y CV (escalar, matriz, hash y código, respectivamente). Tenga en cuenta que el volcado de *g muestra SV = 0x0. Lamentablemente, no parece haber una forma programática de obtener esta información. Un enfoque de instrumento contundente sería capturar la salida de Dump() y analizarla.

+1

Y perls anteriores (anterior a 5.10) siempre tendrán algo en la ranura escalar ... En los perls más nuevos, puede probar '$ {B :: svrev_2object (\\ * f) -> SV} == 0 ' – ysth

3

antigua Perls (pre-5.10) siempre tendrán algo en la ranura escalar.

En las versiones más recientes, parece que el comportamiento antiguo se imita cuando intenta hacer * FOO {SCALAR}.

Puede utilizar el módulo B introspección para comprobar la ranura escalar, sin embargo:

# 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; 
Cuestiones relacionadas