まだ重たいCMSをお使いですか？
毎秒1000リクエスト を捌く超高速CMS「adiary」

2012/09/28(金)Perlの型グロブと名前空間アクセスの応用

はてブ数 プログラム::Perl

Perlの名前空間と型グロブに関する応用的な話です。高度な内容ですので、少なくともリファレンスについては理解している人向けです。型グロブも多少知らないと難しいかもしれません。

※以下特に断りがない限りPerl 5.10での動作確認です。

型グロブとは

Perlの名前空間にアクセスする際に出てくるものです。prefrefによれば型グロブには次のようなものがあります。

$scalarref = *foo{SCALAR};
$arrayref  = *foo{ARRAY};
$hashref   = *foo{HASH};
$coderef   = *foo{CODE};
$ioref     = *foo{IO};
$globref   = *foo{GLOB};
$formatref = *foo{FORMAT};

この場合「foo」という名前空間をにある色々な型の変数（のリファレンス）一覧が取得できます。

例えば、次のプログラムを実行してみます。

#!/usr/bin/perl
use strict;
#------------------------------------------
package TEST;
our $x=10;
#------------------------------------------
package main;

print "$x\n";

$TEST::x = 20;
print "$x\n";

my $y = *TEST::x;
$$y = 30;
print "$x\n";

実行結果。

$ test.pl
10
20
30

この動作は、Perlの名前空間と型グロブを理解していないと難しいかもしれません。*1

「package TEST」の中で「x」という変数を宣言すると「TEST::x」という名前空間にスカラー変数の領域が作られます。*TEST::xというのは、そのまま名前空間を参照して型グロブを取得しています。

名前空間 → 特定の名前の型グロブ → スカラー、配列、ハッシュ、関数……

もう少し型グロブのサンプルを掲示します。

#!/usr/bin/perl
use strict;
#------------------------------------------
package TEST;
sub func {
	return $_[0] + $_[1];
}
our $func = "string";
#------------------------------------------
package main;
sub mul {
	return $_[0] * $_[1];
}

print &TEST::func(10,20),"\n";
print *TEST::func{SCALAR},"\n";
print *TEST::func{CODE},"\n";

*TEST::func = \&mul;

print &TEST::func(10,20),"\n";
print *TEST::func{SCALAR},"\n";
print *TEST::func{CODE},"\n";
print $TEST::func,"\n";

実行結果

$ test.pl
30
SCALAR(0x1e63b10)
CODE(0x1e63a98)
200
SCALAR(0x1e63b10)
CODE(0x1e71960)
string

今度は「TEST」の中のfuncを直接書き換えています。関数を置き換えていますが、スカラ変数はそのままです。

型グロブに値を代入するときは、代入する型に合わせた部分のみ書き換わります。この例では関数（CODE）のみ書き換わりスカラ変数（SCALAR）はそのままです。

*1 : package宣言でごまかしていますが、TESTは別ファイルのモジュールだと思ってください。

名前空間の取得と操作

名前空間を参照し、そこに登録されている名前等を取得することができます。

#!/usr/bin/perl
use strict;
#------------------------------------------
package TEST;
sub func {
	return $_[0] + $_[1];
}
our $x = "string";
our @y = (1,2,3);
our %z = {aa => 123};
my $abc = 50;
#------------------------------------------
package TEST::SUB;
our $aaa = 10;
#------------------------------------------
package main;
my $h = \%{TEST::};	# \%TEST:: でも良い。
foreach(sort(keys(%$h))) {
	print "$_=$h->{$_}\n";
}

実行結果。

$ test.pl
SUB::=*TEST::SUB::
func=*TEST::func
x=*TEST::x
y=*TEST::y
z=*TEST::z

「\%{TEST::}」とすることにより、TESTという名前空間に存在する型グロブの全リスト（ハッシュ）を取得できます。リファレンスの取得ですので、このときの$hを書き換えることは、TEST::以下の該当の名前を書き換えることと等価です。

またTEST::SUB::という名前空間は、TEST::の中に存在することに注意してください。

外部モジュールと名前空間

もう少し複雑なことをしてみます。

test_module.pm ファイルを以下のように作成します。

use strict;
package test_module;

use Exporter qw(import);
our @EXPORT = qw(&add $testx);
our $testx = "test_module's x";

sub new {
	bless({}, shift);
}
sub DESTROY {
	my $self = shift;
	print "*** DESTORY : $self\n";
}
sub add {
	return $_[0] + $_[1];
}
1;

Exporterの働きにより、use test_moduleすると「&add」及び「$testx」がインポートされるモジュールです。名前空間を見るとこの動きが非常によく分かります。

#!/usr/bin/perl
use strict;
use lib './';
#------------------------------------------
package TEST;
use test_module;

sub func {
	return $_[0] + $_[1];
}
#------------------------------------------
package main;
foreach(sort(keys(%TEST::))) {
	print "$_=",*TEST::->{$_},"\n";
}

print *{TEST::add}{CODE},"\n";
print *{test_module::add}{CODE},"\n";

名前空間のリスト表示を違う表示方法に変えてあります。

実行結果。

$ ./test.pl
BEGIN=*TEST::BEGIN
add=*TEST::add
func=*TEST::func
testx=*TEST::testx
CODE(0x21a4798)
CODE(0x21a4798)

名前空間 TEST:: の中には本来は &func しか存在しませんが、それ以外の要素がインポートされました。BEGINはExporterが自動生成したものだと思われますが、add や testx は test_module からエクスポートされたものです。

最後のCODEの出力を見れば分かるとおり、&TEST::add と &test_module::add は同じ実体を示しています。

名前空間の開放と変数の開放

名前空間からの開放は簡単です。先ほどの例なら

package main;
my $x = \%{TEST::};	# 追加}
delete $x->{add};	# 追加}
foreach(sort(keys(%TEST::))) {
#||<
と書き換えて実行すると分かります。
>||
$ ./test2.pl
BEGIN=*TEST::BEGIN
func=*TEST::func
obj=*TEST::obj
testx=*TEST::testx

しかし、名前空間から削除しただけでは変数領域自体は消去されません。それを確認するため次のようなプログラムを実行しました。

#!/usr/bin/perl
use strict;
use lib './';
#------------------------------------------
package TEST;
use test_module;

sub func {
	return $_[0] + $_[1];
}
our $obj = new test_module;
our @obj = (new test_module);
my $abc = new test_module;
#------------------------------------------
package main;

my $x = \%{TEST::};
delete $x->{obj};
print " TEST::obj=",$TEST::obj,"\n";
print "*TEST::obj=",*TEST::->{obj},"\n";

print "abc=",$abc,"\n";
print "*** END\n";

実行結果。

$ ./test2.pl
 TEST::obj=test_module=HASH(0x20f1d48)
*TEST::obj=
abc=test_module=HASH(0x21169b8)
*** END
*** DESTORY : test_module=HASH(0x21169b8)
*** DESTORY : test_module=HASH(0x20f1d48)
*** DESTORY : test_module=HASH(0x20f1f40)

プログラムの実行が終了してから（「*** END」後）デストラクタが呼ばれています。つまり「delete $x->obj;」をした段階では名前空間から除去されてもオブジェクト（メモリ領域）自体は残り続けているということです。それどころか「$TEST::obj」で参照できてしまいます。*2

またレキシカル変数である「$abc」の値が消えていないことにも注意してください。実際レキシカル変数は名前空間には現れません。グローバル変数とは扱いや挙動が異なります。（{ }のスコープやファイルが有効範囲です。）

今度は「delete $x->{obj};」を「undef $x->{obj};」に書き換えてみます。

$ ./test.pl
*** DESTORY : test_module=HASH(0x1786d48)
*** DESTORY : test_module=HASH(0x1786f40)
 TEST::obj=
*TEST::obj=*TEST::obj
abc=test_module=HASH(0x17ab9b8)
*** END
*** DESTORY : test_module=HASH(0x17ab9b8)

undefにより無事にメモリは開放されていることが分かります。配列もスカラも両方開放されました。しかし、deleteしてないため、TEST:: 名前空間に「型グロブobj」は残っています。

名前空間まとめ

  • 名前空間からdeleteしても、メモリは開放されない。
  • 型グロブに対して undef することで、その型グロブ（名前）に属するすべての型の変数が開放される。*3

*2 : 名前空間から削除したのならば参照自体が無効になっていいはずなのですが、この挙動は謎です。

*3 : 「open(FH, "file")」等のファイルハンドルもクローズされることを排他ロックを使って確認しました（Perl 5.8/5.10にて）。

応用：動的な関数のフック

これまでのことを応用して、モジュール内関数に対する動的なフックを実現してみます。

hook.pm。

use strict;
package hook;

use Exporter qw(import);
our @EXPORT = qw(&hook);

sub hook {
	no strict 'refs';
	my $pkg = shift;
	# "$pkg::"と書くと、それ自体がクラス参照になり動作しない
	my $pkgcc = $pkg . '::';
	my $names = \%{ $pkgcc };
	foreach(keys(%$names)) {
		# その型グロブに関数が存在しなければ無視する
		if (! *{"$pkgcc$_"}{CODE}) { next; }

		# new や import 等は hook しない
		if ($_ eq 'new' || $_ eq 'import'
		 || $_ eq 'BEGIN' || $_ eq 'DESTROY') { next; }

		# ラッパーが既に存在すれば何もしない
		my $wrap_func = "_wrap_$_";
		if (*{"$pkgcc$wrap_func"}{CODE}) { next; }

		# 現在ある関数の頭に _wrap_ をつけたものに名前を移動する
		*{"$pkgcc$wrap_func"} = *{"$pkgcc$_"}{CODE};

		# ラッパーを仕込む（元々の関数名にクロージャを代入）
		my $func = $_;
		*{"$pkgcc$_"} = sub {
			my $self = shift;
			# 同じパッケージから呼び出されたときは単に元関数をcall
			if ((caller)[0] eq $pkg) {
				return $self->$wrap_func(@_);
			}
			print ">>call $func\n";
			if (wantarray) {
				my @r = $self->$wrap_func(@_);
				print "<<end $func (return ",join(',',@r),")\n";
				return @r;
			}
			my $r = $self->$wrap_func(@_);
			print "<<end $func (return $r)\n";
			return $r;
		}
	}
}

1;

「no strict 'refs'」に注意して下さい。変数によって名前空間にアクセスするためには、参照制約を外す必要があります。ただしファイル全体で外す必要はなく、適切なスコープの中でのみオフにすれば十分です。

処理の内容として、元々の関数名の先頭に _wrap_ を付けて名前を変更し、元々の関数名のところへフックルーチンを含めたクロージャを置いています。クロージャについては解説しませんので、各自調べてください。

続いて動作例です。計算モジュール calc.pm をフックしてみます。calc.pm では hook.pm をインポートし、ファイルの最後で呼び出しています。

use strict;
package calc;
use hook;

use Exporter qw(import);
our @EXPORT = qw(&add &mul &fact);

sub new {
	bless({}, shift);
}
sub add {
	my $self = shift;
	return $_[0] + $_[1];
}
sub mul {
	my $self = shift;
	return $_[0] * $_[1];
}
sub fact {	# 階乗
	my $self = shift;
	my $v = int(shift);
	if ($v<=1) { return 1; }
	return $v * $self->fact($v-1);
}

# 自分自身のパッケージ名を引数としてフック関数を呼び出す
&hook(__PACKAGE__);

1;

実行ファイルはこちらです。

#!/usr/bin/perl
use strict;
use lib './';
use calc;

my $c = new calc;
$c->add(10,20);
$c->mul(10,20);
$c->fact(10);

続いて実行結果です。calc.pmに出力ルーチンは一切書いてないにも関わらず、hook.pmの動的フックにより関数呼び出しの様子が出力されています。

$ ./test.pl
>>call add
<<end add (return 30)
>>call mul
<<end mul (return 200)
>>call fact
<<end fact (return 3628800)

無制限に動的なフックを行うと予期せぬ結果になることがあるので、hookしていい関数などを予め限定するとよいでしょう。

使い方によっては非常に応用範囲の広い技になります。*4

*4 : adiary V3では色々な種類のDBモジュールに対して、その処理時間計測のためのフックモジュールとして利用しました。

応用：ライブラリの自動リロード

今までのことを使ってライブラリを自動リロードすることができます。

例えば、FastCGIやSpeedyCGI環境ではライブラリやプログラムをキャッシュすることで動作を高速化していますが、ライブラリを書き換えた時にはそれらのプロセスを自動ですべて削除しなければまなりません。

もしくはライブラリ（形式のアプリケーション本体）のタイムスタンプを保持し、タイムスタンプの変更を検出することで、この処理が終わったらプロセスを殺し次の処理のときに新たにロードし直す処理を行うことはできますが、検出したその時は古い状態のまま実行されます。それでも構わないと言えば構わないのですが、開発環境などではこれが結構厄介な問題で、プログラムを書き換えて実行テストをするために2回リロードする必要が出てきてしまいます。*5

さらに言えばmod_perl環境では、Apacheを再起動しない限りライブラリはロードされっぱなしです。*6

具体的な方法

ソースがとても長くなりますので示しませんが、ポイントだけ抑えておきます。

  1. プログラム終了時、%INC の中からライブラリ更新検出対象のものをグローバル変数ないしはレキシカル変数に更新時刻等と共に保存しておく。仮に %libs とする。
  2. プログラム開始時、何よりも先に %libs に保存されているライブラリが更新されているかチェックする。
  3. もし更新されているものがあったら、対象のライブラリ（1つ、ないしはuse等で互いに依存しているならば対象全部）をアンロードする。

アンロードのタイミングと方法を間違えなければ、プログラムは新規にスタートしたのとほぼ同じ状態で開始されます。

アンロードルーチン

パッケージをアンロードするためのルーチンを示します。自由に利用して頂いて構いません。

#------------------------------------------------------------------------------
# ●指定されたパッケージをアンロードする
#------------------------------------------------------------------------------
sub unload {
	no strict 'refs';

	my $pkg = shift;
	delete $INC{$pkg};
	$pkg =~ s/\.pm$//;
	$pkg =~ s[/][::]g;
	my $names = \%{ $pkg . '::' };
	# パッケージの名前空間からすべて除去
	foreach(keys(%$names)) {
		substr($_,-2) eq '::' && next;
		undef $names->{$_};	# 全型の変数開放
		# delete $names->{$_};
	}
}
  • 「$pkg . '::'」を「"$pkg::"」と書き換えてはいけません。それ自体が名前空間参照となり期待した動作をしなくなります。
  • 「::」で終わるものを無視しているのは、すでに見た通り TEST と TEST::SUB の名前空間があったとき、TEST:: 名前空間の中に SUB:: として TEST::SUB:: が存在するからです。
  • 「delete $names->{$_};」をするとライブラリリロード後のグローバル変数の参照に不具合が出るようなので止めました。

*5 : webアプリケーションならば更新検出時は同じURLにリダイレクトすることでごまかすことができますが（adiary Ver2等での手法）、POSTはリダイレクトできないという決まりがあるため万能ではありません。

*6 : Apache::Reloadというモジュールもあるにはあります。

まとめ

リファレンスや型グロブ、そして名前空間を使った応用のお話でした。

Perlをここまで使ってる人がどの程度居るのかわかりませんが、こういう小賢しいことができてしまうのがイタズラみたいで面白いなと思っています。逆に魔法みたいで嫌いって人も多いみたいですけど。

質問とかありましたら、コメントまたはtwitterでリプライいただければ幸いです。