5

型グロブが与えられた場合、どの型が実際に定義されているかを見つけるにはどうすればよいですか?

私のアプリケーションでは、単純な構成形式として 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" ;
    }
}

my.config:

@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（ファイルハンドル）
$ JACKPOT
@OPTIONS
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' =>'bee'）
$ 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 
no strict 'refs';
my $func_name = 'myfunc';
*{$func_name}{CODE}()
use strict 'refs';
于 2011-04-05T08:32:33.060 に答える
1

聞きたくないのですが、型グロブをいじる代わりに、実際の構成形式に切り替えてみませんか? たとえば、 Config::SimpleとYAMLをチェックしてください。

通常の場合、型グロブとシンボルテーブルをいじることはお勧めしません (一部の CPAN モジュールはそれを行いますが、大規模なシステムの最下位レベルでのみです。たとえば、Class::MOP の最下位レベルの Moose など)。Perl は、作業するための多くのロープを提供しますが、そのロープは、注意しないと、自己認識して首に自分で結び付けるのにも非常に満足しています :)

関連項目: Perl で構成ファイルをどのように管理しますか?

于 2010-08-03T14:55:26.723 に答える
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 ];

この出力は、各型グロブのどの部分が定義されているかを把握するのに十分な情報を提供すると思います。

'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 に答える