Module::Pluggable Source Code Reading
Module::Pluggable
import()
まずModule::Pluggableってのはuse時に各種パラメータを指定して使うモジュールなんで、
まずはimportメソッドから。
sub import { my $class = shift; my %opts = @_; my ($pkg, $file) = caller; # the default name for the method is 'plugins' my $sub = $opts{'sub_name'} || 'plugins'; # get our package my ($package) = $opts{'package'} || $pkg; $opts{filename} = $file; $opts{package} = $package; my $finder = Module::Pluggable::Object->new(%opts); my $subroutine = sub { my $self = shift; return $finder->plugins(@_) };
%optsとして渡せる値の一つ、sub_nameってのはdefaultがpluginsで、名前の変更が出来るっぽぃのと、
通常callerで取得する呼び出し元のpackageをpackageってオプションで変更出来るってのが分かる。
finderオブジェクトとしてModule::Pluggable::Objectってのを生成して、クロージャでfinderのpluginsメソッドを叩くサブルーチンリファレンスを生成してると。
my $searchsub = sub { my $self = shift; my ($action,@paths) = @_; $finder->{'search_path'} = ["${package}::Plugin"] if ($action eq 'add' and not $finder->{'search_path'} ); push @{$finder->{'search_path'}}, @paths if ($action eq 'add'); $finder->{'search_path'} = \@paths if ($action eq 'new'); return $finder->{'search_path'}; };
$searchsubの定義だけど$finderの中身を追わずとも何となく想像つくレベル。
$actionがaddの時は、$finderのsearch_pathがundefならば$package::Pluginってのをsearch_pathに入れて、その後に指定された@pathsがあれば全部追加。
newの時は@pathsを全部突っ込む。
ちなみに$actionがそれ以外だったら単なるアクセサとして働く。
my $onlysub = sub { my ($self, $only) = @_; if (defined $only) { $finder->{'only'} = $only; }; return $finder->{'only'}; };
$finderのonlyプロパティに対するgetter/setterですね。
my $exceptsub = sub { my ($self, $except) = @_; if (defined $except) { $finder->{'except'} = $except; }; return $finder->{'except'}; };
これも同様にexceptに対するsetter/getter
no strict 'refs'; no warnings 'redefine'; *{"$package\::$sub"} = $subroutine; *{"$package\::search_path"} = $searchsub; *{"$package\::only"} = $onlysub; *{"$package\::except"} = $exceptsub;
で最後に呼び出し元パッケージまたは指定したパッケージの型グロブに上記のように出来たサブルーチンリファレンスをつけておしまい。
つまりModule::Pluggableをuseしたモジュールでは基本的には下記のようになります。*1
- pluginsメソッドが追加される*2
- search_pathメソッドが追加される
- onlyメソッドが追加される
- exceptメソッドが追加される
package指定がされてる場合は指定したpackageに突っ込みに行きます。
Module::Pluggable::Object
new()
sub new { my $class = shift; my %opts = @_; return bless \%opts, $class; }
渡した%optsはもれなく全てblessされますw
でModule::Pluggable->importで定義するサブルーチンリファレンスの中で唯一使ってるModule::Pluggable::Objectのメソッドは
pluginsメソッドだけなので次はそれを追います。
plugins()
sub plugins { my $self = shift; # override 'require' $self->{'require'} = 1 if $self->{'inner'}; my $filename = $self->{'filename'}; my $pkg = $self->{'package'}; # automatically turn a scalar search path or namespace into a arrayref for (qw(search_path search_dirs)) { $self->{$_} = [ $self->{$_} ] if exists $self->{$_} && !ref($self->{$_}); } # default search path is '<Module>::<Name>::Plugin' $self->{'search_path'} = ["${pkg}::Plugin"] unless $self->{'search_path'};
inner指定をしておけばrequireが1に書き換えられます。*3
search_path, search_dirsを必要ならばscalarからarrayrefに変換して、search_pathが未定義な場合、$pkg::Pluginを初期値とした配列リファレンスとして設定。
# check to see if we're running under test my @SEARCHDIR = exists $INC{"blib.pm"} && $filename =~ m!(^|/)blib/! ? grep {/blib/} @INC : @INC;
自分でモジュール作ってる時の探索パスの補正ですね。
なるほど、確かにこういう事してくれないと不便ですな。メモメモ。
# add any search_dir params unshift @SEARCHDIR, @{$self->{'search_dirs'}} if defined $self->{'search_dirs'};
ユーザー指定のsearch_dirsを優先的に@SEARCHDIRに入れておくと。
my @plugins = $self->search_directories(@SEARCHDIR); return () unless @plugins;
ここでsearch_directories()メソッドが呼ばれると。
無ければ空リストを返して終了。
search_directories()
sub search_directories { my $self = shift; my @SEARCHDIR = @_; my @plugins; # go through our @INC foreach my $dir (@SEARCHDIR) { push @plugins, $self->search_paths($dir); } return @plugins; }
ディレクトリごとにsearch_paths()メソッドを呼んで、pluginsに追加するって感じですね。
search_paths()
かなり長いルーチンですが、頑張って読みます。w
sub search_paths { my $self = shift; my $dir = shift; my @plugins; my $file_regex = $self->{'file_regex'} || qr/\.pm$/;
恐らくこの後使うであろう、file探索の為のregexも指定出来る！
必要なのか？w
# and each directory in our search path foreach my $searchpath (@{$self->{'search_path'}}) { # create the search directory in a cross platform goodness way my $sp = catdir($dir, (split /::/, $searchpath)); # if it doesn't exist or it's not a dir then skip it next unless ( -e $sp && -d _ ); # Use the cached stat the second time
予め探索パス*4として指定したsearch_pathを::でsplitしてdirのお尻に付け加えて$spに代入。
これでこの$spが存在し、ディレクトリなら続く。
my @files = $self->find_files($sp);
find_files()は指定されたディレクトリ以下にあるfile_regexで指定されたパターンまたは*.pmでファイルを探索するメソッドで、
まぁここは読み飛ばす事にしておく。（ぉ
# foreach one we've found foreach my $file (@files) { # untaint the file; accept .pm only next unless ($file) = ($file =~ /(.*$file_regex)$/);
ファイルのパターンマッチが失敗したら次に飛ばす。
と言うかここで型グロブ使えるんだ。。。すげぇ。
# parse the file to get the name my ($name, $directory, $suffix) = fileparse($file, $file_regex); $directory = abs2rel($directory, $sp);
File::Basenameのfileparse()ですな。
で絶対パスから相対パスに変換したのが$directoryです。
# If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. my @pkg_dirs = (); if ( $name eq lc($name) || $name eq uc($name) ) { my $pkg_file = catfile($sp, $directory, "$name$suffix"); open PKGFILE, "<$pkg_file" or die "search_paths: Can't open $pkg_file: $!"; my $in_pod = 0; while ( my $line = <PKGFILE> ) { $in_pod = 1 if $line =~ m/^=\w/; $in_pod = 0 if $line =~ /^=cut/; next if ($in_pod || $line =~ /^=cut/); # skip pod text next if $line =~ /^\s*#/; # and comments if ( $line =~ m/^\s*package\s+(.*::)?($name)\s*;/i ) { @pkg_dirs = split /::/, $1; $name = $2; last; } } close PKGFILE; }
全部大文字、あるいは小文字のようなファイル名、例えばZIGOROU.pm, zigorou.pmみたいな場合の処理ですね。
実際にファイル開いて、m/^\s*package\s+(.*::)?($name)\s*;/iにマッチするライン、つまるところpackage宣言を見つけて、
そこから$nameのprefixとなる部分を切り出して@pkg_dirsに突っ込んで終了です。何故こんな回りくどい処理するんだ？
# then create the class name in a cross platform way $directory =~ s/^[a-z]://i if($^O =~ /MSWin32|dos/); # remove volume
ボリュームラベルを削除。
そういえば作るモジュール、全然Windowsの事は考慮してないやw*5
my @dirs = (); if ($directory) { ($directory) = ($directory =~ /(.*)/); @dirs = grep(length($_), splitdir($directory)) unless $directory eq curdir(); for my $d (reverse @dirs) { my $pkg_dir = pop @pkg_dirs; last unless defined $pkg_dir; $d =~ s/\Q$pkg_dir\E/$pkg_dir/i; # Correct case } } else { $directory = ""; } my $plugin = join '::', $searchpath, @dirs, $name;
うーん、黒魔術のようなソースですね。。。
($directory) = ($directory =~ /(.*)/); でディレクトリっぽぃ文字列ってのは担保出来るのだろうか。出来そうな気はするけど、それ以外も入りそうなので、処理として微妙臭い．
ともあれ入念にも思えるチェックを経て、pluginモジュールと思しき文字列を見つけます。
next unless $plugin =~ m!(?:[a-z\d]+)[a-z\d]!i;
my $err = $self->handle_finding_plugin($plugin);
carp "Couldn't require $plugin : $err" if $err;
push @plugins, $plugin;
}
一応$pluginがpackage名と思しき文字列かどうか確認した後に、handle_finding_plugin()メソッドを叩いて、エラーが無ければ@pluginsに突っ込みます。
# now add stuff that may have been in package # NOTE we should probably use all the stuff we've been given already # but then we can't unload it :( push @plugins, $self->handle_innerpackages($searchpath) unless (exists $self->{inner} && !$self->{inner}); } # foreach $searchpath return @plugins; }
で、出来上がった@pluginsを返す、と。長いし読みづらいw
handle_finding_plugin()
sub handle_finding_plugin { my $self = shift; my $plugin = shift; return unless (defined $self->{'instantiate'} || $self->{'require'}); $self->_require($plugin); }
instantiateが定義されていなく、かつrequireが指定されていなければそのまま問題無く通過して*6、
そうで無ければ_requireを呼ぶと。
_require()
sub _require { my $self = shift; my $pack = shift; local $@; eval "CORE::require $pack"; return $@; }
requireしてるだけっちゃそうなんだけど、CORE::requireと呼ぶ辺りが入念ですね。
plugins()
でまたplugins()メソッドの続きから。
# exceptions my %only; my %except; my $only; my $except; if (defined $self->{'only'}) { if (ref($self->{'only'}) eq 'ARRAY') { %only = map { $_ => 1 } @{$self->{'only'}}; } elsif (ref($self->{'only'}) eq 'Regexp') { $only = $self->{'only'} } elsif (ref($self->{'only'}) eq '') { $only{$self->{'only'}} = 1; } } if (defined $self->{'except'}) { if (ref($self->{'except'}) eq 'ARRAY') { %except = map { $_ => 1 } @{$self->{'except'}}; } elsif (ref($self->{'except'}) eq 'Regexp') { $except = $self->{'except'} } elsif (ref($self->{'except'}) eq '') { $except{$self->{'except'}} = 1; } }
only, exceptはそれぞれARRAYREF, Regex, SCALARで指定出来るのですが、
それらから恐らく除外用のハッシュを作る。
# remove duplicates # probably not necessary but hey ho my %plugins; for(@plugins) { next if (keys %only && !$only{$_} ); next unless (!defined $only || m!$only! ); next if (keys %except && $except{$_} ); next if (defined $except && m!$except! ); $plugins{$_} = 1; }
onlyのフィルタは%onlyのkeyがきちんと定義されててkeyに存在しないpluginは除外。
また正規表現の場合は、定義されててマッチしなければ除外。
exceptは完璧に逆ですね。
# are we instantiating or requring? if (defined $self->{'instantiate'}) { my $method = $self->{'instantiate'}; return map { ($_->can($method)) ? $_->$method(@_) : () } keys %plugins; } else { # no? just return the names return keys %plugins; }
instantiateが定義されてて、その名前のメソッドが定義されているpluginだけ、
そのメソッドを叩いた結果の配列が返り、そうで無ければpackage名の配列が返る。
ちなみにinstantiateで指定した名前のメソッドには元々pluginsで指定した引数をそのまま渡すので、
画一的なインターフェースを用意しているのであればここでインスタンス化しても構わないですね。
まとめ
大体やってる事と出来る事は把握出来たかなーって感じですけど、いかんせん処理が重たそう。
PlaggerではModule::Pluggable::Fastを使ってるんですが、何となくその理由が分かった気がしました。w
まとめの追記
plugins()メソッドってのは基本１回しか叩かないメソッドだと考えられます。
どう見ても何度も叩くメソッドとしては設計されてないw
最も設定値を変更が可能なので、再び異なるパターンでpluginの探索や生成を行うなら話は別ですけども。
