MouseX::Foreign (a port of MooseX::NonMoose) released!

ずっとやろうと思っていてやっていなかったMooseX::NonMoose の Mouse版をようやく書き上げました。なかなか完成しなかったのは、いい名前が思いつかなかったのと、Mouse本体に組み込めるかどうかの検討をしたかったからです。検討の結果、Mouse本体に組み込むのは無理があるという結論に達したため、モジュールとしてリリースすることにしました。

以下のようにすることで、Mooseクラスを含む任意のクラスを継承できます。ただし、ハッシュリファレンスベースのオブジェクトでなければならないのと、複数の「foreign class」を親に持つことができないという制限はありますが。

#!perl
package MyDateTime;
use Mouse;
#use MouseX::StrictConstructor;
use MouseX::Foreign qw(DateTime);

has foo => (
    is      => 'rw',
    default => 'bar',
);

# MyDateTime->newの引数をDateTime->newの引数へ変換する
# 戻り値はDateTime->newの理解できるリスト
sub FOREIGNBUILDARGS {
    my $class = shift;
    return @_ ; # 今回は何もしなくても大丈夫
}
# MyDateTime用の引数をセットアップする
# 戻り値はハッシュリファレンス
sub BUILDARGS {
    my $class = shift;
    my $args  = $class->SUPER::BUILDARGS(@_);
    # strict constructor付きの場合は
    # 加工しないとまずいが、今回は省略
    return $args;
}

__PACKAGE__->meta->make_immutable();
package main;
use Test::More;
my $dt = MyDateTime->now;
is $dt->foo, 'bar';
isnt $dt->epoch, 0;
note $dt;
done_testing;
__END__

場合によってはFOREIGNBUILDARGSとBUILDARGSの中身がかなり面倒なことになりますが、とにかく、これで継承はできます。

なおこの変更に伴い、Mouseで非Mouseなクラス*1を継承すると警告がでるようになりました。そのようなケースはもともと動かなかった(あるいは、たまたま動いているように見えただけの)ケースなので大丈夫だとは思いますが、問題があれば報告していただけると助かります。問題があるようであれば警告を無効にしますので。

*1:具体的には、newないしDESTROYメソッドを持ったパッケージ