『実行可能なモジュール』と私が勝手に呼んでいる、ある種の設計パターン/コーディングイディオムについて、
私なりの意見を整理しておこうと思います。
(この設計パターンは Perl 以外の言語でもよく見かけるので、既に名前が付いているのでは?と予想しています。
教えて頂けるとありがたいです)
pm に shbang と unless caller を書く
unless caller
Perl スクリプトで、ファイルの最後にこんなコードを見たことが有る人は、いるでしょうか?
unless (caller) {
...何らかの処理...
}
この unless (caller) {...}
のブロックは、このファイルをコマンドとして直接起動した時だけ
呼ばれる処理を記述したものです。私が初めてこの種の書き方に触れたのは 1996頃の
Perl/Tk の文脈
で、
MainLoop unless caller;
と書いて
- このスクリプト自体が起動された時は、
Tk::MainLoop()
を呼び出す
- それ以外のケース、例えば上記スクリプトを別プログラムからクリップボード経由で直接 eval したり
do
などでロードした時は、何もしない。
という動作を実現するために使われていました。
myscript.pl の代わりに MyScript.pm
さて、この unless caller
というイディオムは、 Tk に限らず一般の Perl スクリプトでも役に立ちます。
例えばスクリプトを書く時、 myscript.pl
の代わりに MyScript.pm
という名前にして package
文も書いて、
正当なモジュールとしてロードできるようにします。その上で、最後に unless caller
で、コマンドとして
起動された時の処理を書くのです。
例えば以下のように書きます。
#!/usr/bin/env perl
package MyScript;
...
unless (caller) {
my @opts;
push @opts, split /=/, shift(), 2 while @ARGV and $ARGV[0] =~ /=/; XXX
my $app = MyScript->new(@opts);
$app->main(@ARGV);
}
1;
すると、この MyScript.pm
は (chmodして) 直接コマンド行ツールとして起動するだけでなく、
モジュールとしてロードし、一部のメソッドだけを呼び出すことも出来るようになります。
% ./MyScript.pm x=100 y=100 foo bar
% perl -I. -MMyScript -le 'print MyScript->new->foo'
サブコマンドをメソッドに対応付ける
先の例では unless caller
時には MyScript->new->main
を呼ぶように決め打ちしてありました。
ここを
- posix style の long option
--name=value
の列を new()
の引数にする。
--name
のみなら --name=1
として扱う。 --debug
みたいに。
- 次に来た引数をサブコマンドの名前に使う。
という動作にすればどうでしょう? こんなイメージです。
% ./MyScript.pm --dbname=foo.db import journal.tsv
% ./MyScript.pm --dbname=foo.db list_accounts
早速、これを実現する unless caller
ブロックを書いてみましょう。
parse_opts()
は後で定義することにします。
unless (caller) {
my @opts = parse_opts(\@ARGV);
my $self = __PACKAGE__->new(@opts);
my $cmd = shift @ARGV || "help";
my $method = "cmd_$cmd";
$self->can($method) or die "No such subcommand: $cmd";
$self->$method(@ARGV);
}
- ここでサブコマンドのメソッド名に接頭辞
cmd_
を付けることにしたのは、
例えば import
というメソッド名が Perl にとって特別な意味の有るメソッド名で、
これと被ると予期せぬ面倒を生みかねないからです。
発展:任意のメソッドをサブコマンドとして試せるようにする
先の unless caller
ブロックで呼び出せるのは cmd_...
で始まる名前のメソッドだけでした。
これを任意のメソッドまで呼べるように拡張すれば、内部的なメソッドも CLI から
簡単に呼び出して試せるようになります。特に Perl は REPL が弱いので、
これを使えば好きなメソッドを shell のヒストリ・エディタ上で反復的に試せるようになり、
REPL の弱さを補うことが出来ます。
ただし、普通のメソッドは結果を Perl のスタックに返すだけで画面には何も出しませんから、メソッドの結果を
出力する機能も作る必要があります。また戻り値は undef や []
, {}
... を含みますから、
出力時はシリアライザーを通したほうが良さそうです。
以上を考えた unless caller
ブロックは、例えばこんな感じでしょうか>
use Data::Dumper;
unless (caller) {
my @opts = parse_opts(\@ARGV);
my $self = __PACKAGE__->new(@opts);
my $cmd = shift @ARGV || "help";
if (my $sub = $self->can("cmd_$cmd")) {
$sub->($self, @ARGV);
}
elsif ($sub = $self->can($cmd)) {
my @res = $sub->($self, @ARGV);
print Data::Dumper->new(\@res)->Dump;
}
else {
die "No such subcommand: $cmd";
}
}
もちろん、もっと強化できる所はあります。
@res
の内容に応じて終了コードを設定すると、シェルスクリプトから使う時に便利になります。
- スカラーコンテキストとリストコンテキストをオプションで使い分けられると嬉しい人もいるでしょう。
- 出力時のシリアライザーを JSON にする手もあります
- 引数の文字列が
{...}
, [...]
の形式の時に JSON としてデコードする手も、ありえます。
この辺りに興味の有る方は MOP4Import::Declare の
MOP4Import::Base::CLI_JSON
もどうぞ…
この設計パターンの使いどころ
あまり有効でないケース
先に、このパターンがあまり有効でない状況を挙げます。
- 開発するプログラムの仕様が十分に確定しており、設計に時間を掛ける余裕が有る。
- 開発者が十分に足りていて、モジュールを分割するほど、手分けして並列で開発を進められる。
- 作ったけど使わない、という可能性を考えなくて済む。
この記事で挙げたパターンは複数のサブコマンドを一個のスクリプトファイルに書くので、
複数人で並行開発することは困難だろうからです。
有効に働くケース
逆に、
- 何を作れば『ビジネス上の要求』を満たせるか分からない、探索的な開発をする必要が有る。
- 顧客が要求仕様をまとめられず、どんなコマンドを何個作ることになるか、全然予測できない。
- それを作っても使うか分からない、業務に投入してみないと何も言えない時。
という状況下で、それでも前進しないと駄目な時には、以下のメリットがあります。
- 最初から OOP 用のクラス・モジュールとして書いているので、いつでも継承してメソッドの挙動を変える、など自由自在に
OOP の技法を投入できる。
- もし初手をコマンドとして書き後からクラスへ括り出す場合だと、そこでクラスの命名で悩む時間を取られる。
- サブコマンドを増やし放題。メソッドへ括り出し放題。あらゆる無茶振りを一旦受け止めるための、汚れ役クラスとも言える。
- CLI ベースで作って、後から Web 経由で (Fat な) Model として使う、という手も有る。
- モジュールになっているので、テストも書きやすい。
とは言え、これで作ったものは巨大な一枚 pm になりがちなので、機会を見つけて整理をするのが大事、ではあります。
(…吐血…)
なんでこれ書いたのか
songmu さんの blog 記事
www.songmu.jp
私も UNIX 哲学は好きで、概ね同意できる、と思いつつ…
自分が Perl で仕事のツールを書く時によく使うスタイルの話も書いておいたほうが、誰かの役に立つかもな〜、と思ったからでした。
おまけ
parse_opts()
の例です(既存のコードを解説用に簡略化したものなので、動作は未検証です)>
sub parse_opts {
my ($list, $result) = @_;
$result //= [];
while (@$list and my ($n, $v) = $list->[0]
=~ m{^--$ | ^(?:--? ([\w:\-\.]+) (?: =(.*))?)$}xs) {
shift @$list;
last unless defined $n;
push @$result, $n, $v // 1;
}
wantarray ? @$result : $result;
}
更新履歴
- 2018-07-11: 最初の例の手抜きオプションパーサーの無限ループバグを修正
- 2018-0609: google groups の Perl/Tk 記事へのリンクを直した