perl: итерация над typeglob

Question

Учитывая тип glob, как я могу найти, какие типы на самом деле определен?

В моем приложении пользователь PERL является простым форматом конфигурации. Я хотел бы потребовать() пользовательский файл конфигурации, а затем увидеть, какие переменные определены, а также какие типы они есть.

Код: (сомнительного качества совещательным)

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

выход:

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

Answer 1

В полностью общем случае, вы не можете делать то, что вы хотите получить следующую выдержку из perlref:

*foo{THING} возвращает undef, если это значение THING еще не используется, за исключением случаев, когда скаляры. *foo{SCALAR} возвращает ссылку на анонимный скаляр, если $foo еще не был использован. Это может измениться в будущей версии.

Но если вы готовы принять ограничение, что любое скалярное должен иметь определенное значение, которое будет обнаружено, то вы можете использовать код, например

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

получит Вас там.

С my.config из

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

Выходом является

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

---

Печать имен занимает мало работы, но мы можем использовать модуль Data::Dumper принять часть бремени. Вводная похож:

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

Нам нужно сбросить различные слоты немного по-разному и в каждом случае удалить атрибуты ссылок:

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

Наконец, цикл по множеству разностях между %before и %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; 
    } 
    } 
} 

Использование my.config из вашего вопроса, выход

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

Answer 2

UPDATE:
gbacon прав. * glob {SCALAR}.

Вот результат я получаю с помощью кода:

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) 

Это несмотря на Foo2 определяется как хэш, но не как скаляр.

ОРИГИНАЛЬНЫЙ ОТВЕТ:

Если я вас правильно понимаю, вы просто должны использовать defined встроенный.

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

Начиная с 5.010, вы можете различать, существует ли SCALAR с использованием модуля B самоанализа; см Detecting declared package variables in perl

Обновление: пример, скопированный из этого ответа:

# 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

Рабочий код, используя модуль CPAN, который получает некоторые волосы из пути, Package::Stash. Как отмечалось в моем комментарии к ответу gbacon, это слепо, чтобы файл конфигурации делал $someval = undef, но это кажется неизбежным, и по крайней мере другие случаи пойманы. Он также ограничивает себя в скаляр, ARRAY, HASH, КОД и типы IO - получение GLOB и FORMAT возможно, но это делает код менее довольно, а также создает шум на выходе :)

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

Если вы не возражайте анализировать данные :: Dump output, вы можете использовать его, чтобы разделить различия.

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

Используя этот код со следующим файлом конфигурации:

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

Я считаю, что этот вывод дает достаточно информации, чтобы иметь возможность выяснить, какие части каждого типа Glob определены:

'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

Мне не нравится спрашивать, но вместо того, чтобы возиться с typeglobs, почему бы не переключиться на реальный формат конфигурации? например выезд Config::Simple и YAML.

В обычных случаях я бы не рекомендовал использовать таблицы типов и таблиц символов (некоторые модули CPAN делают это, но только на нижних уровнях больших систем - например, Moose на самых низких уровнях класса :: MOP). Perl дает вам много веревки, чтобы работать, но веревка также весьма рад самостоятельной noosify и самостоятельный галстук вокруг-ваша шея, если вы не будете осторожны :)

Смотри также: How do you manage configuration files in Perl?

Answer 7

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