perl：迭代一個typeglob

Question

給定一個typeglob，我怎樣才能找到實際定義的類型？

在我的應用程序中，我們將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}如果尚未使用特定的THING則返回undef ，除了標量的情況。 *foo{SCALAR}如果$foo尚未使用，則*foo{SCALAR}返回對匿名標量的引用。 這可能會在將來的版本中發生變化。

但是，如果您願意接受任何標量必須具有要檢測的定義值的限制，那么您可以使用諸如

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

從5.010開始，您可以使用B內省模塊區分是否存在SCALAR; 請參閱在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 3

使用CPAN模塊工作代碼，使一些頭發脫離， Package :: Stash 。 正如我對gbacon的回答所說的那樣，這對配置文件做了$someval = undef是盲目的，但這似乎是不可避免的，至少其他情況都被抓住了。 它還限制了SCALAR，ARRAY，HASH，CODE和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 4

更新：
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內置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 5

我討厭問，但為什么不切換到真正的配置格式，而不是亂搞typeglobs？ 例如，查看Config :: Simple和YAML 。

我不建議在正常情況下使用typeglobs和符號表（一些CPAN模塊會這樣做，但僅限於大型系統的底層 - 例如，Class :: MOP中最低級別的Moose）。 Perl為你提供了很多可以使用的繩索，但是如果你不小心的話，那根繩子也非常樂意自我消除和自我束縛你的脖子:)

另請參閱： 如何在Perl中管理配置文件？

Answer 6

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

Answer 7

如果你不介意解析Data :: Dump輸出，你可以用它來梳理差異。

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