クラスメソッドのエクスポート

Pythonとかだと、たとえばsome.packageにFooっていうクラスが定義してあって

from some.package import Foo

foo = Foo(name='Rintaro')

というようにコンストラクタ＝クラス名() だったりします。 Perlはパッケージ=名前空間=クラス名なのが一般的なのでちょっと事情が違うのですが、Perlでも

use Foo;
$foo = Foo(name=>'Rintaro');

みたいにコンストラクタを呼び出したい！っていうお話。

簡単にやるなら

package Foo;

use base qw(Exporter);
@EXPORT = qw(Foo)
sub Foo { Foo->new(@_); }

sub new { my $class = shift; bless {@_},$class }

ってな感じになると思うのですが、これだと

use Foo;
Foo->Foo(name => 'Rintaro');

とかやられると困ってしまいます。そこで

package Foo;
use strict;

sub import {
    my $class = shift;
    my $caller = caller();
    no strict 'refs';
    *{$caller . '::' . $class } = sub { $class->new(@_); };
}

一見うまく行きます。が、Foo::Barクラスでこれをやってしまうと、

package main;
use Foo::Bar;
$foobar = Foo::Bar(name=>'Rintaro');

&main::Foo::Bar関数を定義していることになり、Foo:: 名前空間を犯してしまっていて具合がよくありません。

そこでコンストラクタを呼び出す関数名を指定できるようにします。

sub import {
    my($class, $funcname) = @_;
    my $caller = caller();
    no strict 'refs';
    *{$caller . '::' . $funcname } = sub { $class->new(@_); };
}

こうすれば

use Foo::Bar qw(FooBar);
$foobar = FooBar(name => 'Rintaro');

というように FooBar() で Foo::Bar->new を呼び出すことが出来ます。

もっと進んでこれをモジュール化します。名前はExport::ClassMethod。

ついでに、クラス側でインポートされる関数名を指定できるようにし、 また、その関数で呼び出されるクラスメソッド名を指定できるようにしましょう。

package Foo::Bar;

use Export::ClassMethod (
    FooBar => 'new',
    FBTest => 'test',
);

sub new { ... }
sub test { ... }

として、

package main;
use Foo::Bar qw(FooBar FBTest);

とするだけで、Foo::Bar->newを呼び出す FooBar と Foo::Bar->test を呼び出す BFTest がインポートされます。

package Export::ClassMethod;
use strict;

sub import {
    my($exporter, %exports) = @_;
    my $exportclass = caller();
    no strict 'refs';
    *{$exportclass . '::import'} = _import(\%exports);
}

sub _import {
    my($exports) = @_;
    sub {
        my($class, @imports) = @_;
        my $importer = caller();
        for my $import (@imports) {
            if(not exists $exports->{$import}) {
                require Carp;
                Carp::croak("'$import' is not exported by $class");
            }
            my $method = $exports->{$import};
            no strict 'refs';
            *{$importer . '::' . $import} = sub {$class->$method(@_)};
        }
    }
}

Exporter.pm と併用できないのでそれ相当の機能とチェック機構は用意しなきゃいけないし、 use Export::ClassMethod しているクラスが継承されたときの挙動も考えなきゃいけないし、 もう既にCPANに似たようなモジュールがあったら教えていただけると助かりますー