今回のテーマ
今回は、
サンプルアプリケーション
本連載では、svn co -r 455 http://
attributeとは
attributeとは、
たとえばCatalystを利用してControllerを書くときには
sub auto : Private {
my ( $self, $c ) = @_;
...
}
/code>
などと書きますよね。この例ではPrivateの部分がattributeになります。
この説明だけでは、
Perl標準で利用できるattribute
たとえば標準ではlvalueという属性が利用できます。
package Jitensya;
use strict;
use warnings;
sub new { bless { sound => 'リンリン' }, shift }
sub sound : lvalue {
shift->{sound};
}
1;
package main;
use strict;
use warnings;
my $mama = Jitensya->new;
print $mama->sound; # 「リンリン」と出力
$mama->sound = 'チリンチリン';
print $mama->sound; # 「チリンチリン」と出力
と記述でき、
標準で利用できるattributeはlvalueの他に、
ただ、
Package-specific Attribute Handling
自作モジュール中に独自のattributeを実装する事もできます。普通の状態では、
#example.pl
use strict;
use warnings;
sub foo : bar {
}
$ perl ./example.pl
Invalid CODE attribute: bar at ./example.pl line 4
BEGIN failed--compilation aborted at ./example.pl line 5.
ではどうするのかというと、
#example2.pl
use strict;
use warnings;
print "script start\n";
sub MODIFY_CODE_ATTRIBUTES {
my ($pkg, $ref, @attrs) = @_;
print "MODIFY_CODE_ATTRIBUTES: set up\n";
print "MODIFY_CODE_ATTRIBUTES: attrs: $_\n" for @attrs;
return;
}
sub test : catalyst sledge(miyagawa) soozy(yappo) boofy {
print "test: start\n";
}
test;
$ perl ./example2.pl
MODIFY_CODE_ATTRIBUTES: set up
MODIFY_CODE_ATTRIBUTES: attrs: catalyst
MODIFY_CODE_ATTRIBUTES: attrs: sledge(miyagawa)
MODIFY_CODE_ATTRIBUTES: attrs: soozy(yappo)
MODIFY_CODE_ATTRIBUTES: attrs: boofy
script start
test: start
このような形でattributeを活用する事が出来ます。
更に詳細の話は、
余談になりますが、
WARNING: the mechanisms described here are still experimental. Do not rely on the current implementation. In particular, there
is no provision for applying package attributes to ’cloned’ copies of subroutines used as closures. (See "Making References" in
perlref for information on closures.) Package-specific attribute handling may change incompatibly in a future release.
と記載されており、
Attribute::Handlers
attributeを簡単に利用する為のCPANモジュールという物が存在しています。これは、
これを利用したCPANモジュールも、
実際どのように使うかを、
#example3.pl
use strict;
use warnings;
use Attribute::Handlers;
sub sample : ATTR(CODE) { # attributeとして実装したいメソッドに ATTR(CODE) というattributeを指定する
my($package, # メソッドの属するパッケージ名
$symbol, # メソッドのシンボル (シンボルテーブルで、そのまま使える文字列)
$referent, # メソッドのコードリファレンス
$attr, # attribute名
$data, # attributeに渡された引数
$phase # このsampleメソッドが実行されている、Perl上の実行フェーズ
) = @_; # ATTR(CODE) を指定したメソッドに対しては、上記の引数が渡される
my $name = *{$symbol}{NAME};
no warnings 'redefine';
*{$symbol} = sub {
warn "goto: $package->$name : $attr($data)";
goto &$referent;
};
}
sub geek : sample(hoge) {
my $name = shift;
print "$name geek\n";
}
geek('a');
geek('e');
geek('g');
$ perl ./example3.pl
goto: main->geek : sample(hoge) at ./example3.pl line 10.
a geek
goto: main->geek : sample(hoge) at ./example3.pl line 10.
e geek
goto: main->geek : sample(hoge) at ./example3.pl line 10.
g geek
このように比較的簡単にattributeを実装できます。より詳細な内容はperldoc Attribute::Handlersを実行するか、
Attributeを活用したPlugin作成術
このattributeをplugin的に利用してる例がDBIx::Class(以下DBIC)です。詳しくはDBIx::Class::ResultSetManagerというモジュールのドキュメントに書いてあるのですが、
#DBIx::Class::ResultSetManagerのPODより
# in a table class
__PACKAGE__->load_components(qw/ResultSetManager Core/); # note order!
# will be removed from the table class and inserted into a
# table-specific resultset class
sub search_by_year_desc : ResultSet {
my $self = shift;
my $cond = shift;
my $attrs = shift || {};
$attrs->{order_by} = 'year DESC';
$self->search($cond, $attrs);
}
$rs = $schema->resultset('CD')->search_by_year_desc({ artist => 'Tool' });
ResultSetManagerを参考にして、
どの辺りで実装されているかは、
Class::Componentでpluginを作る
Class::ComponentはDBICのResultSetManagerを参考にして、
Gopper::Plugin以下にモジュールを追加する
pluginを作る為には、
package Gopper;
use strict;
use warnings;
our $VERSION = '0.01';
use Class::Component;
use base qw( Class::Accessor::Fast );
__PACKAGE__->mk_accessors( qw/ config engine / );
#以下略
今回は例として、
package Gopper::Plugin::Method::ConfigDump;
# 別にGopper::Plugin::ConfigDumpでもよいんだけど
# Gopper的には Method::ConfigDump が望ましい
use strict;
use warnings;
use base 'Class::Component::Plugin';
use YAML;
sub config_dump : Method { # Gopperに config_dump メソッドが追加される
my($self, # ConfigDump pluginのインスタンス
$c # Gopper のインスタンス
) = @_;
$c->log(debug => $self->to_yaml($c));
}
sub to_yaml { # Gopper には影響しないメソッド
my($self, $c) = @_;
Dump $c->config;
}
1;
たったこれだけのコードでGooperに対してメソッドを追加するpluginが書けました。
まず、
その後はpluginとして実装したい事を自由に書きます。各pluginのモジュールはGopper本体や他のpluginと干渉しないオブジェクトになっているので、
メソッドを生やす？
Gopperにメソッドを追加する為に肝心な事は、
厳密にいうとメソッドが生えるわけではなく$gooper->call('config_
package Foo;
use strict;
use warnings;
use base 'Class::Component::Plugin';
__PACKAGE__->load_components(qw/ Autocall::InjectMethod /);
1;
といったコードを書く事により、
追加したモジュールを利用可能にする
ただpluginを書いただけではGopperに影響を与える事は出来ません。そこで追加したpluginを利用するコードを書く必要があります。
何をするかと言うと、
まずはpluginのロードです。
use lib file( $FindBin::RealBin, 'lib' )->stringify;
use Gopper;
Gopper->load_plugins(qw/ Method::ConfigDump /);
load_
次は追加したメソッドの呼び出しです。gopper.
sub start {
my $gopper = Gopper->new(config => shift);
$gopper->call('config_dump');
$gopper->run;
}
callメソッドで、
実行してみよう！
追加したコードを実際に動かしてみましょう。gopper.
#config.yaml
global:
log:
level: debug
engine:
module: Simple
config:
host: localhost
port: 11170
plugins:
- module: Protocol::Gopher
今回は、
この設定を用いて実行すると以下のようになります。
$ ./gopper.pl -c config.yaml
Gopper [debug] setup engine Gopper::Engine::Simple
Gopper::Plugin::Method::ConfigDump [debug] ---
global:
engine:
config:
host: localhost
port: 11170
module: Simple
log:
level: debug
plugins:
- module: Protocol::Gopher
Gopper [debug] engine.preper
Gopper::Plugin::Method::ConfigDump [debug]の部分からconfigがdumpされました。
デーモンとして動作しているので、
pluginで追加されたメソッドがうまく動いた事が確認出来ましたね。この例を応用すればClass::Componentでのplugin作成は自在に出来ると思います。
Class::Component速報
今現在、
次回予告
今回は、