5

给定一个 typeglob，我怎样才能找到实际定义的类型？

在我的应用程序中，我们使用 PERL 作为一种简单的配置格式。我想 require() 用户配置文件，然后能够查看定义了哪些变量，以及它们是什么类型。

代码：（有问题的质量咨询）

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

我的配置：

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

输出：

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

7 回答 7

7

在完全一般的情况下，由于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!
.

输出是

%学分
FH（文件句柄）
$头奖
@选项
WinMessage（格式）
&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' => '蜜蜂')
$C = '看'
于 2010-08-02T20:50:55.383 回答
3

从 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;
于 2010-08-02T21:47:16.813 回答
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};
}
于 2010-08-02T21:50:31.353 回答
1

更新：
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";
        }
    }
}
于 2010-08-02T20:51:32.450 回答
1

我不想问，但不要乱用 typeglob，为什么不切换到真正的配置格式呢？例如检查Config::Simple和YAML。

我不建议在正常情况下使用 typeglobs 和符号表（一些 CPAN 模块会这样做，但仅限于大型系统的底层 - 例如，在 Class::MOP 的最低级别中的 Moose）。Perl 给了你很多可以使用的绳子，但是如果你不小心的话，那根绳子也很乐意自我纠缠和自我系在你的脖子上:)

另请参阅：如何在 Perl 中管理配置文件？

于 2010-08-03T14:55:26.723 回答
1 
no strict 'refs';
my $func_name = 'myfunc';
*{$func_name}{CODE}()
use strict 'refs';
于 2011-04-05T08:32:33.060 回答
0

如果您不介意解析 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;
}
于 2010-08-02T22:13:53.233 回答