gihyo.jpサイトのロゴ

Perlでプラガブルモジュールを作ろう！

第3回attributeを拡張してpluginに変化を加える

2007-10-26

今回のテーマ

前回は、Perlのattributeという仕組みを解説しました。今回は、さらにattributeの実戦的な利用方法として、(Perlとしては実験的な実装という扱いですが)パッケージ固有のattribute実装の方法と、Class::Component::Attributeを拡張してplugin作りを便利にする方法を取り上げます。

サンプルアプリケーション

本連載では、プラガブルなモジュールを作製するという事を考えて、Gopperという実際に実行可能なサンプルアプリケーションを元に解説を行ないます。GopperはCodeRepos上のsvnリポジトリに置いてあるので各自checkoutしてください。

svn co -r 659 http://svn.coderepos.org/share/lang/perl/Gopper/trunk Gopper

パッケージ固有のattribute実装

Perlのattributeに関しては前回の記事を参照してください。今回はPerlのattributeで利用できるMODIFY_CODE_ATTRIBUTESについてを深く掘り下げて解説します。

attributeを独自に定義する為に

attributeを独自に定義するには、MODIFY_type_ATTRIBUTES メソッドを定義する必要が有ります。typeには、 CODE / SCALAR / ARRAY / HASH の4種類のどれかで置きかえます。CODEだったらMODIFY_CODE_ATTRIBUTESになります。

attributeは、BEGINフェーズにて解釈されるので、MODIFY_type_ATTRIBUTESメソッドの定義はattributeを利用するコードよりも先に書かれている必要があります。

正しい例
# test.pl
use strict;
use warnings;

BEGIN { print "B:1\n" }

sub MODIFY_CODE_ATTRIBUTES {
    print "MODIFY_CODE_ATTRIBUTES\n";
    return;
}

BEGIN { print "B:2\n" }

sub test: hoge {}

BEGIN { print "B:3\n" }
出力
$ perl ./test.pl
B:1
B:2
MODIFY_CODE_ATTRIBUTES
B:3
間違った例
# test2.pl
use strict;
use warnings;

BEGIN { print "B:1\n" }

sub test: hoge {} # あれ？MODIFY_CODE_ATTRIBUTESは？

BEGIN { print "B:2\n" }

sub MODIFY_CODE_ATTRIBUTES {
    print "MODIFY_CODE_ATTRIBUTES\n";
    return;
}

BEGIN { print "B:3\n" }
出力
$ perl ./test2.pl
B:1
Invalid CODE attribute: hoge at ./test2.pl line 6
BEGIN failed--compilation aborted at ./test2.pl line 6.

SCALAR / ARRAY / HASH に関しては、それぞれ変数をmy宣言する時に利用されるattributeをハンドリングします。

# test3.pl
use strict;
use warnings;

sub MODIFY_SCALAR_ATTRIBUTES {
    print "MODIFY_SCALAR_ATTRIBUTES\n";
    return;
}

sub MODIFY_ARRAY_ATTRIBUTES {
    print "MODIFY_ARRAY_ATTRIBUTES\n";
    return;
}

sub MODIFY_HASH_ATTRIBUTES {
    print "MODIFY_HASH_ATTRIBUTES\n";
    return;
}

my $scalar : hoge ;
my @array : hoge ;
my %hash : hoge ;
出力
$ perl ./test3.pl
MODIFY_SCALAR_ATTRIBUTES
MODIFY_ARRAY_ATTRIBUTES
MODIFY_HASH_ATTRIBUTES

MODIFY_type_ATTRIBUTESの実装内容

MODIFY_type_ATTRIBUTESが呼び出される仕組みはattributes.pmに記述されており。perldoc -m attributesで確認することが出来ます。Perlのコンパイラはsub method : attributes {}のような記述があると内部的にattributesをロードし、attributes->importを呼び出します。importを呼び出すときにattributeされるオブジェクトのリファレンスとattribute宣言の内容のリストを引数として渡します。

例えば下記のコードのような挙動になります。

sub hoge : attr1 attr2 attr3 {}
# 上のような宣言が有るときは、内部的に下記を実行
require attributes;
attributes->import( \&hoge, qw( attr1 attr2 attr3 ) );

この時のimportで渡される一つ目の引数のリファレンスの内容を見て、どのMODIFY_type_ATTRIBUTESを使うかを決定しています。

MODIFY_type_ATTRIBUTESへの引数

引数は、とても単純でattributeを与えられるオブジェクトへのリファレンスと、実際のattributesのリストが渡されます。 

sub MODIFY_CODE_ATTRIBUTES {
    my(
        $class,     # $code_refのメソッドが所属するpackage名
        $code_ref,  # attributeを与えられるメソッドのコードリファレンス
        @attributes # attributesが配列で渡される
    ) = @_;
}

$code_refに関しては、MODIFY_CODE_ATTRIBUTESで呼び出された時点では、まだサブルーチンのコンパイルが終了していないので、MODIFY_CODE_ATTRIBUTES内で$code_ref->()として呼び出すと

Undefined subroutine called at ファイル名 line 行番号.

というエラーが出ます。

なお、これはMODIFY_CODE_ATTRIBUTESでのみ発生し、SCALAR / ARRAY / HASHでは発生しません。

# test4.pl
use strict;
use warnings;

sub MODIFY_SCALAR_ATTRIBUTES {
    my($class, $ref, @attrs) = @_;
    $$ref = 'hoge';
    return;
}

sub MODIFY_ARRAY_ATTRIBUTES {
    my($class, $ref, @attrs) = @_;
    @$ref = @attrs;
    return;
}

sub MODIFY_HASH_ATTRIBUTES {
    my($class, $ref, @attrs) = @_;
    $ref->{key} = 'value';
    return;
}

my $a : foo;
print "$a\n";

my @a : bar1 bar2 bar3;
print join ', ', @a;
print "\n";

my %a : baz;
print "$a{key}\n";
出力
$ perl ./test4.pl
hoge
bar1, bar2, bar3
value

MODIFY_type_ATTRIBUTESの戻り値

MODIFY_type_ATTRIBUTESの戻り値としては、引数で渡された@attributesの中で、利用が出来ないattributesをリストにして返します。例えば、ブログサービス名だけをatteributeに付けたい場合は下記のようなコードになります。

# test5.pl
use strict;
use warnings;

sub MODIFY_CODE_ATTRIBUTES {
  my($class, $code, @attributes) = @_;
  return grep { $_ !~ /^vox|hatena|livedoor|jugem|ameblog$/ } @attributes;
}

sub accounts : hatena livedoor jugem {}
sub wazato_error : hatena gihyo sd vox {}
出力
$ perl ./test5.pl
Invalid CODE attributes: gihyo : sd at ./test.pl line 11
BEGIN failed--compilation aborted at ./test.pl line 11.

このようにMODIFY_CODE_ATTRIBUTESの中で定義されていないgihyoとsdに問題があると、エラーが出ました。

FETCH_type_ATTRIBUTES

FETCH_type_ATTRIBUTESは、オブジェクトに関連づけられたattributeを取り出すときに利用されます。具体的には、attributes::get(\&hoo)として呼び出されたときに、hooメソッドに割り当てられてるattributeを返すために呼ばれるメソッドです。

# test6.pl
use strict;
use warnings;

my %cache;

sub MODIFY_CODE_ATTRIBUTES {
  my($class, $code, @attributes) = @_;
  $cache{$code} = \@attributes;
  return;
}

sub FETCH_CODE_ATTRIBUTES {
  my($class, $code) = @_;
  return @{ $cache{$code} || [] };
}

sub method : perl python ruby {}

print join ', ', attributes::get(\&method);
print "\n";
出力
$ perl ./test6.pl
perl, python, ruby

筆者としては、有効な使い方を見出せていませんが、きっと面白い使いかたがあると思います。

再利用可能にする

今までのサンプルでは、全てmain package上にMODIFY_CODE_ATTRIBUTESを書いていました。各モジュール中に独自のattributeを実装したいときに、全てのpackageにMODIFY_CODE_ATTRIBUTESを定義していたのでは無駄がありますね。これを回避するには、MODIFY_CODE_ATTRIBUTESを定義するモジュールを別に作っておき、そのモジュールをuse baseする事により使いまわしが出来るようになります。

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

my %cache;

sub MODIFY_CODE_ATTRIBUTES {
  my($class, $code, @attributes) = @_;
  $cache{$code} = \@attributes;
  return;
}

sub FETCH_CODE_ATTRIBUTES {
  my($class, $code) = @_;
  return @{ $cache{$code} || [] };
}

1;

# test7.pl
use strict;
use warnings;
use base 'AttributeBase';

sub foo : bar baz {}

print join ', ', attributes::get(\&foo);
print "\n";
出力
$ perl ./test7.pl
bar, baz

その他

my $foo = sub {}形式のサブルーチン宣言時にもattributeの指定が可能です。

# test8.pl
use strict;
use warnings;
use base 'AttributeBase';

my $code = sub : foo bar baz {};

print join ', ', attributes::get($code);
print "\n";
出力
$ perl ./test8.pl
foo, bar, baz

有効な利用例は思いつきませんが、覚えておくと面白いコードを書きたくなった時に重宝する事でしょう。

CPANモジュールに目を向ける

さてCPANモジュールで利用されているattributeの実装に目を向けてみましょう。Class::Componentを作成した時に参考にしたDBIx::ClassとCatalystでの実装を紐解きます。

DBIx::Classでの利用例

DBIx::Classで行われているattributeの実装は、DBIx::Class::ResultSetManagerで利用されています。

DBIx::Class::ResultSetManagerはtable schemaで利用出来るコンポーネントです。これは何をする物かというと、$schema->resultset('Table')をして取り出した任意のテーブルのresultsetに対してメソッドを追加出来ます。簡単に検証する為には下記の3ファイルを作成するだけで検証出来ます。

まずはSchemaクラスの作成です。

# Schema.pm
package Schema;
use strict;
use warnings;
use base qw/DBIx::Class::Schema/;
__PACKAGE__->load_classes;
1;

次にテーブルクラスです。

# Schema/Test.pm
package Schema::Test;
use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components(qw/ ResultSetManager Core /);
__PACKAGE__->table('test');

sub next_perl_version : ResultSet {
    print "5.10.0\n";
}

1;

最後にスクリプトファイルを書きます。

# schematest.pl
use strict;
use warnings;
use Schema;
my $schema = Schema->connect;
$schema->resultset('Test')->next_perl_version;
出力
$ perl ./schematest.pl
5.10.0

このようにResultSetというattributeを指定をするだけで簡単にメソッドが追加出来るようになりました。注意としてはテーブルクラスにて__PACKAGE__->table('テーブル名')として、tableメソッドを呼び出さないとResultSet attributeの初期化を行いません。

DBIx::Classでの実装内容

上の例ではResultSetの拡張でしか説明しませんでしたが、DBIx::Classではattributeを使った他の拡張も実装出来ます。DBIx::Class::ResultSetManagerのソースを見ると解りやすいのですが、_register_attributesメソッド中でmy $cache = $self->_attr_cache;としている行の_attr_cacheというメソッドでattributeが指定されているメソッドの一覧を取得しているのです。

ここで問題が発生するのですが、DBIx::Class::ResultSetManagerの中ではMODIFY_CODE_ATTRIBUTESが実装されていません。どこで実装されているかというと超灯台下暗しなのですがDBIx::Classにて実装されているのです。実際どんな処理かというと、DBIx::Classを継承してくれているpackageに宣言されているattribute宣言をかき集めて、メソッドのコードリファレンスとattributesリストの対応マップを作成し、保存しています。対応表は_attr_cacheメソッドで取得可能です。

このDBIx::Classに実装されているattributeハンドリングの仕組みを活用するコンポーネントを書けば、ResultSetManager以外のattributeを活用した仕組みが構築出来ます。

実はDBIx::Class自体が継承しているモジュール達は、主要な処理が実装されているのではなく、基本中の基本の実装(アクセサ/attribute/load_component)が実装されている程度なので、簡単にDBIx::Class以外の用途に利用する事ができます。

# dbicattr.pl
use strict;
use warnings;
use DBIC;

DBIC->dump_attr(\&DBIC::hello);
DBIC->dump_attr(\&DBIC::dump_attr);

# DBIC.pm
package DBIC;
use strict;
use warnings;
use base 'DBIx::Class';
use YAML;

sub hello : NotDBIC {
    print "hello!\n";
}

sub dump_attr : DUMP {
    my($class, $code) = @_;
    print Dump $class->_attr_cache->{$code};
}

1;
出力
$ perl ./dbicattr.pl 
---
- NotDBIC
---
- DUMP

このように、ちゃっかり利用する事が出来ます。

Catalystでの実装

Catalystでのattribute利用は、ControllerでのDispatch処理に活用しています。 そう、おなじみのIndexやRegex,Chained等です。

Catalystでのattribute実装もClass::Componentで参考しています。しかし基本的な所はDBIx::Classと同じです。いったい何が違うかというと、利用可能なattributeの定義方法がDBIx::Classとは異なります。DBIx::Classでは、attrbiteを処理するコンポーネントが取捨選択をして処理をしていましたが、CatalystではCatalyst::DispatchType以下の名前空間にてモジュールを作成すると自動的に利用可能なattributeが拡張されるのです。

詳細なフローの説明は本題からずれる部分が多いため割愛(ある程度の詳細は、筆者blogCatalystのAttributesが初期化されるまでにて解説があります)しますが、attributeをかき集める処理はCatalyst::AttrContainerに実装されています。Catalyst::AttrContainerは単独で継承して利用する事が出来るので、CatalystのアプリでController以外の場所にattributeを実装したい場合には、Catalyst::AttrContainerを継承してしまえば再利用する事になるので簡単にattribute拡張が行えます。

ここまで読み進めていただいた読者の皆様なら、このCatalyst::AttrContainerがどのような実装になっているかは、今更説明する必要もありませんね:-)

Class::ComponentでAttribute拡張

Class::Componentでも手軽にattributeを拡張するための手段を提供しています。CatalystのDispatchTypeを拡張する時の要領で、MyApp::Attribute以下の名前空間にAttributeの実装を追加するだけです。

Class::Component::Pluginでの実装

実際の拡張の前に、Class::Componentでの実装を見てみましょう。attribute関連の処理は全てClass::Component::Pluginにて実装されています。

MODIFY_CODE_ATTRIBUTESの実装に関しては、ほぼDBIx::Classの実装内容と同等です。相違点は_attr_cacheメソッドが__attr_cacheメソッドへと、_がprefixに一つ多くついています。

pluginの各メソッドに定義されたattributeを検出する実装に関しては、__attr_cacheから対応表を取得してMyApp::Attribute以下の名前空間に実装されているattributeかを調べています。attributeには一つだけ引数を与える事ができて、例えばsub foo : Attr('value') {}と定義されていれば、MyApp::Attribute::Attr packageを利用して、valueを引数としてMyApp::Attribute::Attrを初期化します。

実際に拡張する

実際にGopperに対してattributeを追加してみます。GopperはApacheのhandlerに近い仕組みで、受け取ったリクエストに適合するハンドラプラグインのGopper::Plugin::Handlerがコンテンツを返すように実装されています。前回までのリビジョンでは、ハンドラで指定出来るメソッド名がhandlerというメソッド名に固定でしたが、これを各ハンドラによって名前を変更出来るようにします。具体的にはHandlerという名前のattributeがついたメソッドをハンドラとして実行するように変更します。

attributeを処理するモジュールは下記の通りです。

package Gopper::Attribute::Handler;
use strict;
use warnings;
use base 'Class::Component::Attribute';

sub register {
    my(
        $class,
        $plugin, # attributeが定義されているプラグインのインスタンス
        $c,      # 大元のモジュールのインスタンス
        $method, # attributeが定義されているメソッドの名前
        $value,  # 上記Attr('value')の例で言う所のvalue
        $code    # attributeが定義されているメソッドのcoderef
    ) = @_;
    $plugin->handler_method($method); # ハンドラとして利用するメソッド名を設定する
}
1;

一見すると行数が多いですが、肝の部分は一行という驚異的な短さですね。

その他にも全開のリビジョンから、さまざまなファイルを変更する必要がありました。変更内容一覧はCodeReposのTracを参照できますが、念のために変更箇所を引用します。

ハンドラメソッドの呼び出し方をhandlerメソッドに固定されていたのを動的に指定可能にする。

--- lib/Gopper.pm       (revision 1213)
+++ lib/Gopper.pm       (local)
@@ -62,7 +62,8 @@
 sub run_handler_hook {
     my($self, $stash) = @_;
     return RC_FORBIDDEN unless my $handler = $stash->request->handler;
-    return $handler->handler($self, $stash) || RC_FORBIDDEN;
+    my $handler_method = $handler->handler_method;
+    return $handler->$handler_method($self, $stash) || RC_FORBIDDEN;
 }

 sub run_request {

ハンドラモジュール中で、Handler attributeを指定して任意のメソッド名に変更する。

--- lib/Gopper/Plugin/Handler/Static.pm (revision 1213)
+++ lib/Gopper/Plugin/Handler/Static.pm (local)
@@ -29,7 +29,7 @@
     return $self->RC_OK;
 }

-sub handler {
+sub send_context : Handler {
     my($self, $c, $stash) = @_;

ハンドラメソッドを記憶しておくアクセサを追加。

--- lib/Gopper/Plugin/Handler.pm        (revision 1213)
+++ lib/Gopper/Plugin/Handler.pm        (local)
@@ -5,4 +5,9 @@

 use base 'Gopper::Plugin';

+sub handler_method {
+    my $self = shift;
+    $self->{handler_method} = defined $_[0] ? $_[0] : $self->{handler_method};
+}
+
 1;

拡張した物を動かしてみる

では、さっそく拡張したGopperがきちんと動くか確かめてみましょう。まずは、前回と同じようにconfigファイルを用意します。


global:
  log:
    level: debug

  engine:
    module: Simple
    config:
      host: localhost
      port: 11170

plugins:
  - module: Protocol::Gopher

  - module: Handler::Static
    config:
      docroot: /tmp/docroot

Gopperのexampleに入っているdocrootを/tmpにコピーします。任意の場所に変えたい時は、上記のconfigファイルの内容も変更して下さい。

$ cp -r example/docroot /tmp/docroot

gopperを起動します。

$ perl ./gopper.pl -c=config.yaml

telnetコマンドを使ってちゃんとコンテンツが帰って来るかを確認します。

$ telnet localhost 11170
Trying 127.0.0.1...
Connected to localhost.localdomain (127.0.0.1).
Escape character is '^]'.

0rfc1436.txt    /rfc1436.txt    localhost       11170
1frameworks     /frameworks     localhost       11170
Connection closed by foreign host.

ちゃんとattributeの拡張が動いている事が確認出来ましたね。

Class::ComponentでもGopperの例のように、簡単にかつ、実用的に、attributeを利用した拡張が行える事ができます。

次回予告

今回は、前回よりもさらにディープなattributeの話題を取り上げました。Class::Componentを利用するしないに関わらずattributeを取り扱う要領を得た事と思います。次回は、話の濃度を薄めにして、「⁠あの」PlaggerとClass::Componentの関係について解説する予定です。

おすすめ記事

記事・ニュース一覧