perl: iterar sobre un typeglob

Question

Dado un typeglob, ¿cómo puedo encontrar qué tipos son realmente definidos?

En mi aplicación, utilizamos PERL como un formato de configuración simple. Me gustaría requerir() el archivo de configuración del usuario, luego poder ver qué variables están definidas, así como qué tipos son.

Código: (asesor calidad cuestionable)

#!/usr/bin/env perl 

use strict; 
use warnings; 

my %before = %main::; 
require "/path/to/my.config"; 
my %after = %main::; 

foreach my $key (sort keys %after) { 
    next if exists $before{$symbol}; 

    local *myglob = $after{$symbol}; 
    #the SCALAR glob is always defined, so we check the value instead 
    if (defined ${ *myglob{SCALAR} }) { 
     my $val = ${ *myglob{SCALAR} }; 
     print "\$$symbol = '".$val."'\n" ; 
    } 
    if (defined *myglob{ARRAY}) { 
     my @val = @{ *myglob{ARRAY} }; 
     print "\@$symbol = ('". join("', '", @val) . "')\n" ; 
    } 
    if (defined *myglob{HASH}) { 
     my %val = %{ *myglob{HASH} }; 
     print "\%$symbol = ("; 
     while( my ($key, $val) = each %val) { 
      print "$key=>'$val', "; 
     } 
     print ")\n" ; 
    } 
} 

my.config:

@A = (a, b, c); 
%B = (b=>'bee'); 
$C = 'see'; 

de salida:

@A = ('a', 'b', 'c') 
%B = (b=>'bee',) 
$C = 'see' 
$_<my.config = 'my.config' 

Answer 1

En el caso totalmente general, usted no puede hacer lo desea gracias al siguiente extracto de perlref:

*foo{THING} devuelve undef si esa COSA particular no se ha utilizado aún, excepto en el caso de los escalares. *foo{SCALAR} devuelve una referencia a un escalar anónimo si $foo no se ha utilizado aún. Esto podría cambiar en una versión futura.

Pero si usted está dispuesto a aceptar la restricción de que cualquier escalar debe tener un valor definido a detectar, entonces es posible usar un código como

#! /usr/bin/perl 

use strict; 
use warnings; 

open my $fh, "<", \$_; # get DynaLoader out of the way 

my %before = %main::; 
require "my.config"; 
my %after = %main::; 

foreach my $name (sort keys %after) { 
    unless (exists $before{$name}) { 
    no strict 'refs'; 
    my $glob = $after{$name}; 
    print "\$$name\n"    if defined ${ *{$glob}{SCALAR} }; 
    print "\@$name\n"    if defined *{$glob}{ARRAY}; 
    print "%$name\n"    if defined *{$glob}{HASH}; 
    print "&$name\n"    if defined *{$glob}{CODE}; 
    print "$name (format)\n"  if defined *{$glob}{FORMAT}; 
    print "$name (filehandle)\n" if defined *{$glob}{IO}; 
    } 
} 

le llevarán hasta allí.

Con my.config de

$JACKPOT = 3_756_788; 
$YOU_CANT_SEE_ME = undef; 

@OPTIONS = qw/ apple cherries bar orange lemon /; 

%CREDITS = (1 => 1, 5 => 6, 10 => 15); 

sub is_jackpot { 
    local $" = ""; # " fix Stack Overflow highlighting 
    "@_[0,1,2]" eq "barbarbar"; 
} 

open FH, "<", \$JACKPOT; 

format WinMessage = 
You win! 
. 

la salida es

%CREDITS 
FH (filehandle) 
$JACKPOT 
@OPTIONS 
WinMessage (format) 
&is_jackpot

---

Impresión de los nombres toma un poco de trabajo, pero podemos utilizar el módulo Data::Dumper a tomar parte de la carga. El texto preliminar es similar:

#! /usr/bin/perl 

use warnings; 
use strict; 

use Data::Dumper; 
sub _dump { 
    my($ref) = @_; 
    local $Data::Dumper::Indent = 0; 
    local $Data::Dumper::Terse = 1; 
    scalar Dumper $ref; 
} 

open my $fh, "<", \$_; # get DynaLoader out of the way 

my %before = %main::; 
require "my.config"; 
my %after = %main::; 

Tenemos que volcar las distintas ranuras de forma ligeramente diferente y en cada caso retire la parafernalia de referencias:

my %dump = (
    SCALAR => sub { 
    my($ref,$name) = @_; 
    return unless defined $$ref; 
    "\$$name = " . substr _dump($ref), 1; 
    }, 

    ARRAY => sub { 
    my($ref,$name) = @_; 
    return unless defined $ref; 
    for ("\@$name = " . _dump $ref) { 
     s/= \[/= (/; 
     s/\]$/)/; 
     return $_; 
    } 
    }, 

    HASH => sub { 
    my($ref,$name) = @_; 
    return unless defined $ref; 
    for ("%$name = " . _dump $ref) { 
     s/= \{/= (/; 
     s/\}$/)/; 
     return $_; 
    } 
    }, 
); 

Por último, un bucle sobre la puesta a punto diferencia entre %before y %after:

foreach my $name (sort keys %after) { 
    unless (exists $before{$name}) { 
    no strict 'refs'; 
    my $glob = $after{$name}; 
    foreach my $slot (keys %dump) { 
     my $var = $dump{$slot}(*{$glob}{$slot},$name); 
     print $var, "\n" if defined $var; 
    } 
    } 
} 

Utilizando el my.config de su pregunta, la salida es

$ ./prog.pl 
@A = ('a','b','c') 
%B = ('b' => 'bee') 
$C = 'see'

Answer 2

ACTUALIZACIÓN:
gbacon es correcto. * glob {SCALAR} está definido.

Aquí está la salida consigo la utilización de su código:

Name "main::glob" used only once: 
possible typo at 
test_glob_foo_thing.pl line 13. 
'FOO1' (SCALAR) 
'FOO1' (GLOB) 
'FOO2' (SCALAR) 
'FOO2' (GLOB) 
'_<my.config' (SCALAR) 
'_<my.config' (GLOB) 

Esto es a pesar foo2 se define como un hash, pero no como un escalar.

respuesta original:

Si he entendido bien, sólo hay que utilizar el defined incorporado.

#!/usr/bin/env perl 

use strict; 
use warnings; 

my %before = %main::; 
require "/path/to/my.config"; 
my %after = %main::; 

foreach my $key (sort keys %after) { 
    if (not exists $before{$key}) { 
     if(defined($after{$key}){ 
      my $val = $after{$key}; 
      my $what = ref($val); 
      print "'$key' ($what)\n"; 
     } 
    } 
} 

Answer 3

A partir de 5.010, se puede distinguir si existe un escalar mediante el módulo B introspección; ver Detecting declared package variables in perl

Actualización: ejemplo copiado de esa respuesta:

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

Answer 4

código de trabajo usando un módulo CPAN que recibe algo del pelo fuera del camino, Package::Stash. Como mencioné en mi comentario a la respuesta de gbacon, esto es ciego al archivo de configuración haciendo $someval = undef pero eso parece ser inevitable, y al menos los otros casos están atrapados. También se limita al escalar, ARRAY, HASH, código y tipos IO - conseguir MUNDIALIZA y FORMATO es posible, pero hace que el código sea menos bonita y también crea ruido en la salida :)

#!perl 

use strict; 
use warnings; 

use Package::Stash; 

sub all_vars_in { 
    my ($package) = @_; 
    my @ret; 

    my $stash = Package::Stash->new($package); 
    for my $sym ($stash->list_all_package_symbols) { 
    for my $sigil (qw($ @ % &), '') { 
      my $fullsym = "$sigil$sym"; 
     push @ret, $fullsym if $stash->has_package_symbol($fullsym); 
    } 
    } 
    @ret; 
} 

my %before; 
$before{$_} ++ for all_vars_in('main'); 

require "my.config"; 

for my $var (all_vars_in('main')) { 
    print "$var\n" unless exists $before{$var}; 
} 

Answer 5

Si no le importe analizar el resultado de Data :: Dump, puede usarlo para desentrañar las diferencias.

use strict; 
use warnings; 
use Data::Dump qw{ dump }; 

my %before = %main::; 
require "my.config"; 
my %after = %main::; 

foreach my $key (sort keys %after) { 
    if (not exists $before{$key}) { 
     my $glob = $after{$key}; 
     print "'$key' " . dump($glob) . "\n"; 
    } 
} 

Utilizando este código con el siguiente fichero de configuración:

$FOO1 = 3; 
$FOO2 = 'my_scalar'; 
%FOO2 = (a=>'b', c=>'d'); 
@FOO3 = (1 .. 5); 
$FOO4 = [ 1 .. 5 ]; 

Creo que esta salida proporciona suficiente información para ser capaz de averiguar qué partes de cada glob tipo se definen:

'FOO1' do { 
    my $a = *main::FOO1; 
    $a = \3; 
    $a; 
} 
'FOO2' do { 
    my $a = *main::FOO2; 
    $a = \"my_scalar"; 
    $a = { a => "b", c => "d" }; 
    $a; 
} 
'FOO3' do { 
    my $a = *main::FOO3; 
    $a = [1 .. 5]; 
    $a; 
} 
'FOO4' do { 
    my $a = *main::FOO4; 
    $a = \[1 .. 5]; 
    $a; 
} 
'_<my.config' do { 
    my $a = *main::_<my.config; 
    $a = \"my.config"; 
    $a; 
} 

Answer 6

Odio preguntar, pero en lugar de perder el tiempo con typeglobs, ¿por qué no cambiar a un formato de configuración real? p.ej. echa un vistazo a Config::Simple y YAML.

No recomendaría jugar con typeglobs y tablas de símbolos en casos normales (algunos módulos de CPAN hacen eso, pero solo en los niveles inferiores de sistemas grandes, por ejemplo, Moose en los niveles más bajos de Class :: MOP). Perl le da una gran cantidad de cuerda para trabajar, pero que la cuerda es también muy feliz de auto-noosify y auto-empate-en torno a-su-cuello si no se tiene cuidado :)

Ver también: How do you manage configuration files in Perl?

Answer 7

no strict 'refs'; 
my $func_name = 'myfunc'; 
*{$func_name}{CODE}() 
use strict 'refs';