perl:迭代一个 typeglob

Question

给定一个 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'

Answer 1

在完全一般的情况下，由于以下来自 perlref 的摘录，您无法做您想做的事:

*foo{THING} returns undef if that particular THING hasn't been used yet, except in the case of scalars. *foo{SCALAR} returns a reference to an anonymous scalar if $foo hasn't been used yet. This might change in a future release.

但是，如果您愿意接受任何标量必须具有定义的值才能被检测的限制，那么您可以使用诸如

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

输出是

%CREDITSFH (filehandle)$JACKPOT@OPTIONSWinMessage (format)&is_jackpot

---

Printing the names takes a little work, but we can use the Data::Dumper module to take part of the burden. The front matter is 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::;

我们需要稍微不同地转储各种插槽，并在每种情况下删除引用的陷阱:

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 = '看到'