perl: iterare su un typeglob

Question

Dato un typeglob, come posso trovare quali tipi sono effettivamente definiti?

Nella mia applicazione, utilizziamo PERL come un semplice formato di configurazione. Mi piacerebbe richiedere() il file di configurazione dell'utente, quindi essere in grado di vedere quali variabili sono definite, nonché quali tipi sono.

Codice: (advisory qualità discutibile)

#!/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'; 

uscita:

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

Answer 1

Nel caso completamente in generale, non si può fare ciò che vuoi grazie al seguente estratto da perlref:

*foo{THING} restituisce undef se quella COSA particolare non è stata ancora utilizzata, tranne nel caso di scalari. *foo{SCALAR} restituisce un riferimento a uno scalare anonimo se $foo non è stato ancora utilizzato. Questo potrebbe cambiare in una versione futura.

Ma se siete disposti ad accettare la restrizione che qualsiasi scalare deve avere un valore definito per essere rilevato, allora si potrebbe utilizzare il codice come

#! /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}; 
    } 
} 

si arriva lì.

Con my.config di

$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! 
. 

l'uscita è

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

---

Stampa i nomi prende un po 'di lavoro, ma possiamo usare il modulo Data::Dumper di prendere parte degli oneri. La questione anteriore è simile:

#! /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::; 

Abbiamo bisogno di eseguire il dump dei vari slot in modo leggermente diverso e in ogni caso rimuovere gli orpelli di riferimenti:

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 $_; 
    } 
    }, 
); 

Infine, un loop all'interno di set-differenza tra %before e %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; 
    } 
    } 
} 

Utilizzando la my.config dalla tua domanda, l'uscita è

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

Answer 2

AGGIORNAMENTO:
gbacon ha ragione. * glob {SCALAR} è definito.

Ecco l'uscita ottengo utilizzando il codice:

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) 

Questo nonostante foo2 essere definito come un hash, ma non come uno scalare.

ORIGINALE RISPOSTA:

Se ho capito bene, è sufficiente utilizzare il defined built-in.

#!/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 partire dal 5.010, è possibile distinguere se esiste uno SCALARE utilizzando il modulo di introspezione B; vedi Detecting declared package variables in perl

Aggiornamento: esempio copiato da quella risposta:

# 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

codice di lavoro utilizzando un modulo CPAN che ottiene alcuni dei capelli di mezzo, Package::Stash. Come notato nel mio commento alla risposta di gbacon, questo è cieco al file di configurazione che fa $someval = undef ma ciò sembra essere inevitabile, e almeno gli altri casi vengono catturati. Essa si limita anche alla SCALARE, ARRAY, hash, CODE, e IO tipi - ottenere GLOB e FORMAT è possibile, ma rende il codice meno bella e crea anche il rumore in uscita :)

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

Se non importa l'analisi di Data :: Dump, potresti usarlo per evidenziare le differenze.

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"; 
    } 
} 

Utilizzando questo codice con il seguente file di configurazione:

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

Credo che questa uscita fornisce informazioni sufficienti per essere in grado di capire quali parti di ogni tipo glob sono definite:

'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 chiedere, ma invece di scherzare con typeglobs, perché non passare a un vero formato di configurazione? per esempio. controlla Config::Simple e YAML.

Non consiglierei di risolvere con typeglobs e tabelle di simboli in casi normali (alcuni moduli CPAN lo fanno, ma solo ai livelli inferiori di sistemi di grandi dimensioni - ad esempio Moose nei livelli più bassi di Class :: MOP). Perl ti dà un sacco di corda con cui lavorare, ma che la corda è anche molto felice di auto-noosify e di auto-tie-intorno-il-tuo-collo, se non stai attento :)

Vedi anche: How do you manage configuration files in Perl?

Answer 7

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