型グロブ

Perl

型グロブってなんぞ、と言うわけで簡単にまとめてみる。

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

our $args = 1;
our @args = (1, 2, 3);
our %args = (1 => 999);
sub args { print "Hello, world!\n"; }

print Dumper  ${ *main::args };
print Dumper \@{ *main::args };
print Dumper \%{ *main::args };

&{ *main::args };

exit;

別に上記のように書く必要性はないんだが、型ブログってのはシンボルテーブルにあるファニー文字を省いた同名の変数を一括に取得できる機能とでもいうのだろう。考え方としてシンボルテーブルには型グロブごとに領域が分割されていて、その型グロブの中にスカラー、配列、ハッシュ等々さらに分割されているんだろうね。と言うわけで下記にシンボルテーブルの内容を表示してみる。

print Dumper \%main::;

「exit」の上部に追加、表示結果、

$VAR1 = 1;
$VAR1 = [
          1,
          2,
          3
        ];
$VAR1 = {
          '1' => 999
        };
Hello, world!
$VAR1 = {
          'version::' => *{'::version::'},
          '/' => *{'::/'},
          'stderr' => *::stderr,
          'SIG' => *::SIG,
          'Tie::' => *{'::Tie::'},
          'utf8::' => *{'::utf8::'},
          '"' => *{'::"'},
          're::' => *{'::re::'},
          'DynaLoader::' => *{'::DynaLoader::'},
          'mro::' => *{'::mro::'},
          'strict::' => *{'::strict::'},
          'stdout' => *::stdout,
          '^R' => *{'::^R'},
          'Regexp::' => *{'::Regexp::'},
          '_<C:/strawberry/perl/lib/auto/Data/Dumper/Dumper.dll' => *{'::_<C:/st
rawberry/perl/lib/auto/Data/Dumper/Dumper.dll'},
          'UNIVERSAL::' => *{'::UNIVERSAL::'},
          'overload::' => *{'::overload::'},
          '$' => *{'::$'},
          '^RE_TRIE_MAXBUF' => *{'::^RE_TRIE_MAXBUF'},
          'Data::' => *{'::Data::'},
          '_<..\\universal.c' => *{'::_<..\\universal.c'},
          'BEGIN' => *::BEGIN,
          '_<..\\mro.c' => *{'::_<..\\mro.c'},
          '!' => *{'::!'},
          'IO::' => *{'::IO::'},
          '^X' => *{'::^X'},
          '_' => *::_,
          'Exporter::' => *{'::Exporter::'},
          'Internals::' => *{'::Internals::'},
          'STDIN' => *::STDIN,
          'Config::' => *{'::Config::'},
          'warnings::' => *{'::warnings::'},
          'DB::' => *{'::DB::'},
          '_<perllib.c' => *{'::_<perllib.c'},
          '1' => *{'::1'},
          '^WARNING_BITS' => *{'::^WARNING_BITS'},
          'CORE::' => *{'::CORE::'},
          'Win32CORE::' => *{'::Win32CORE::'},
          'attributes::' => *{'::attributes::'},
          'stdin' => *::stdin,
          'ARGV' => *::ARGV,
          'INC' => *::INC,
          'ENV' => *::ENV,
          'Scalar::' => *{'::Scalar::'},
          '_<..\\perlio.c' => *{'::_<..\\perlio.c'},
          '_<Win32CORE.c' => *{'::_<Win32CORE.c'},
          'XSLoader::' => *{'::XSLoader::'},
          'B::' => *{'::B::'},
          'args' => *::args,
          'main::' => *{'::main::'},
          'Carp::' => *{'::Carp::'},
          'Win32::' => *{'::Win32::'},
          'PerlIO::' => *{'::PerlIO::'},
          '0' => *{'::0'},
          ' => *{':'},
          '_<..\\xsutils.c' => *{'::_<..\\xsutils.c'},
          '@' => *{'::@'},
          'STDOUT' => *::STDOUT,
          ']' => *{'::]'},
          'Dumper' => *::Dumper,
          '_<win32.c' => *{'::_<win32.c'},
          'STDERR' => *::STDERR,
          'bytes::' => *{'::bytes::'},
          '_<Dumper.c' => *{'::_<Dumper.c'},
          '_<dl_win32.c' => *{'::_<dl_win32.c'}
        };

見にくいがどこかに「args」があるはず。「$args」「@args」「%args」「args」全部、「*main::args」で管理されていますね。面白いですね。型ブログがどんなものか大体わかったが使いどころがわからない。いつ、どこで利用するのだろうが？

package Foo;
use strict;
use warnings;

sub hello {
  print "Hello, world!\n";
}

package main;
use strict;
use warnings;

*h = \&{ *Foo::hello };
h();
exit;

なんか微妙。パッケージ「Foo」の「hello」メソッドが実行されるのだがこんな事やらなくてもと思ってしまう。また、型グロブ同士の受け渡しは下記のようになる。

package Foo;
use strict;
use warnings;

our $aaa = 1;
our @aaa = (1,2,3,4);
our %aaa = (key => 9999);
sub aaa { return; };

package main;
use strict;
use warnings;
use Data::Dumper;

*f = *Foo::aaa;
print Dumper  ${ *f };
print Dumper \@{ *f };
print Dumper \%{ *f };
print &f();
exit;

「*f」は「*main::f」とも書ける。もっともっと役に立つと言うよりも良く使われている利用法が知りたい。と言うわけで、下記のようなものを作ってみた。

# Bar.pm
package Bar;
use strict;
use warnings;

sub import {
	my $class = shift;
	my $pkg = caller;

	$class = (ref $class or $class or __PACKAGE__);
	no strict 'refs';
	*{ $pkg . '::hello'   } = \&hello;
	*{ $pkg . '::morning' } = \&morning;
	*{ $pkg . '::night'   } = \&night;
}
sub hello {
	print "Hello, world!\n";
}
sub morning {
	print "Good Morning\n";
}
sub night {
	print "Good Night\n";
}
1;

実行スクリプト、

#!/usr/bin/perl
use strict;
use warnings;
use lib qw(.);
use Bar;

&hello();
&morning;
night;
exit;

なるほど、少し分かった気がする。もう少し進めてみる。

package Bar;
use strict;
use warnings;

sub import {
	my $class = shift;
	my @methods = @_;
	my $pkg = caller;

	return if (!scalar(@methods));
	$class = (ref $class or $class or __PACKAGE__);
	{
		no strict 'refs';
		foreach my $method (@methods) {
			*{ $pkg . '::' . $method   } = \&{ $method };
		}
	}
}
sub hello {
	print "Hello, world!\n";
}
sub morning {
	print "Good Morning\n";
}
sub night {
	print "Good Night\n";
}
1;

実行スクリプト、

#!/usr/bin/perl
use strict;
use warnings;

use lib qw(.);
use Bar qw(hello morning);

&hello();
&morning();
exit;

実行結果、

Hello, world!
Good Morning

おおお、面白いね。利用したいモジュールがちゃんと利用できた。ちょっと仕組みがわかった気がする。ただ現在ってもっと違う仕組みが利用されている気がする、EXPORT_OKとか、とは言え、こういった仕組みを理解しないでいいかといえば、それは違うだろと思うわけで、型グロブって面白いね。では