スクリプト中の複数パッケージ間で use する方法

Perl の use は import をコンパイル時に自動実行してくれるので便利なのですけど、同じスクリプト中に記述済みのパッケージではなく、モジュール・ファイルに記述されたパッケージをコンパイルすることを前提にしてあります。パッケージをモジュールにしてファイルに切り出せばいいのですが、配布物では、cpanm や perlbrew のようにワンファイルで配布したいときもあります。そこで、パッケージ全部入りスクリプトを手軽に記述する方法を考えてみました。

まず、cpanm が利用している App::FatPacker がやっていることを手打ちでやってみます。これは、簡単に言えば、スクリプト中に lib ディレクトリをまるごとアーカイブして擬似的に埋め込んでいるようなものです。パッケージ間の依存関係の順番を気にせずにパッケージを記述できるという利点があります。欠点は、パッケージが文字列になってしまうことで、テキスト・エディタの構文ハイライトが働かなくなることです。なので、この方法は開発済みのソース・ツリーから App:FatPacker のようなツールを使って自動生成させることを前提にしていると言えます。手打ち向きではありません。

#!/usr/bin/env perl
use strict;
use warnings;
BEGIN{
use 5.008;
my %fatpacked;
$fatpacked{'Myapp/Base.pm'} = <<'MYAPP_BASE';
package Myapp::Base;

sub import {
    my($class) = @_;
    my $pkg = caller;
    no strict 'refs';
    *{"${pkg}::extends"} = sub{ unshift @{"${pkg}::ISA"}, @_; q(); };
    *{"${pkg}::has"} = sub{ my($f) = @_; *{"${pkg}::${f}"} = sub{ return $_[0]{$f} }; q(); };
    return;
}

sub new { return bless{%{$_[1] || +{}}}, ref $_[0] || $_[0] }

1;
MYAPP_BASE

$fatpacked{'Myapp/Foo.pm'} = <<'MYAPP_FOO';
package Myapp::Foo;
use Myapp::Base;
extends qw(Myapp::Base);

has name    => (is => 'ro');
has content => (is => 'ro');

1;
MYAPP_FOO

unshift @INC, sub {
    my $src = $fatpacked{$_[1]} or return;
    open my $fh, '<', \$src or die "error loading $_[1]";
    return $fh;
};
}
package Myapp::Main;
use Myapp::Foo;
use feature qw(say);

my $foo = Myapp::Foo->new({'name' => 'Hello', 'content' => 'world'});
say $foo->name;
say $foo->content;

手打ちならばこそ、構文ハイライトの恩恵に預かりたいわけです。

ちょっと考えてみて、スクリプト中のパッケージはすべてロード済みでコンパイル済みだと嘘を教え込むことを思いつきました。これだけのことで期待した通りに動かせるようになります。ただし、このやりかただと、import の依存関係の順で記述しなければならない制約があります。面倒といえば面倒ですが、それぐらいは許容してもかまわないでしょう。

#!/usr/bin/env perl
use strict;
use warnings;
BEGIN { $INC{$_} = $_ for qw(Myapp/Base.pm Myapp/Foo.pm) }

package Myapp::Base;

sub import {
    my($class) = @_;
    my $pkg = caller;
    no strict 'refs';
    *{"${pkg}::extends"} = sub{ unshift @{"${pkg}::ISA"}, @_; q(); };
    *{"${pkg}::has"} = sub{ my($f) = @_; *{"${pkg}::${f}"} = sub{ return $_[0]{$f} }; q(); };
    return;
}

sub new { return bless{%{$_[1] || +{}}}, ref $_[0] || $_[0] }

package Myapp::Foo;
use Myapp::Base;
extends qw(Myapp::Base);

has name    => (is => 'ro');
has content => (is => 'ro');

package Myapp::Main;
use Myapp::Foo;
use feature qw(say);

my $foo = Myapp::Foo->new({'name' => 'Hello', 'content' => 'world'});
say $foo->name;
say $foo->content;

それにしても、どうせなら Perl のコア・モジュールに、例えば pkgforward なるものがあって、

package pkgforward;
use strict;
use warnings;

sub import {
    my($class, @modules) = @_;
    for my $s (@modules) {
        $s =~ s{::}{/};
        $::INC{"$s.pm"} = "$s.pm";
    }
}

1;

これをオールインワン・スクリプトで使えると良かろうにと思ったりしました。

#!/usr/bin/env perl
use strict;
use warnings;
use pkgforward qw(Myapp::Base Myapp::Foo);

package Myapp::Base;
# 略

package Myapp::Foo;
# 略

package Myapp::Main;
# 略

それとも、例によって私が知らないだけで、既にあったりするのかもしれません。