クラスメソッドのインポート

以前 、「クラスメソッドのエクスポート」っていう記事を書きましたけど、やっぱりインポートする側が自由にやりたいよね、ってことで、

use Import qw(FormValidator::Simple#check as Validate);

とすると、FormValidator::Simple->check() を呼び出す Validate関数 を定義してくれる Import.pm ってのを考えてみました。

つまり、

$result = FormValidator::Simple->check($query => $profile);

と書く代わりに、

$result = Validate($query => $profile);

と書けるようになります。

package Import;

use strict;
use warnings;

sub import {
    my($self, $class_method, %op) = @_;
    return if not $class_method;

    my($class, $method) = split /#/, $class_method, 2;
    my($importer, $call_file, $call_line) = caller;

    my $as = exists $op{as} ? $op{as} : $class;
    if($as !~ /^[_a-zA-Z][_a-zA-Z0-9]*$/) {
        require Carp;
        Carp::croak qq{Invalid function name '$as'}
    }

    # require
    {
        my $module = (exists $op{from} ? $op{from} : $class) . '.pm';
        $module =~ s{::}{/};
        if(not $INC{$module}) {
            eval qq{#line $call_line "$call_file"\n require(\$module); };
            if($@ && (exists $op{from} || $@ !~ /^Can't locate .*? at/)) {
                die $@;
            }
        }
    }

    $method ||= 'new';
    my $func = $class->can($method);
    if(not $func) {
        require Carp;
        Carp::croak qq{Can't locate '$method' method in package '$class'}
    }

    my $f = sub { unshift @_, $class; goto &$func };
    no strict 'refs';
    *{"${importer}::$as"} = $f;
}

1;
__END__

=head1 NAME

Import - Import class method

=head1 SYNOPSIS

  use Import qw(URI#new as URI);

  $uri = URI('http://www.fs-output.com/');

使い方としては

use Import qw(クラス名#メソッド名 as 関数名 from モジュール名);

です。

モジュール名はオプションで、目的のクラスが、そのクラス名とは違うモジュール内で定義されている場合に使用します。具体的には、 fromで指定されたモジュールをrequireします。

メソッド名もオプションで、デフォルトは'new'です。

また、関数名もオプションで、省略された場合はクラス名を使用します。ただし、クラス名が '::' を含む場合はエラーになるので、必ず as で関数名を指定する必要があります。

というわけで、次の二つの使い方は同等です。

use Import qw(URI);
use Import qw(URI#new as URI from URI);

ちなみに、これで作った関数は普通に Class->method(args) と呼び出すよりかなり遅いです。目的のクラスメソッドが何もしないメソッドの場合、3.5倍くらいの時間がかかります。もちろん、普通にそれなりの処理をするメソッドの場合はその差は縮まるのですが。。

悩ましいのがここ:

    my $f = sub { unshift @_, $class; goto &$func };

ここを、

    my $f = sub { $func->($class, @_) };

に変えると、ネイティブの場合とたいして変わらないスピードになるのですが、内部でcroakされた場合に、Import.pm内でのエラーとなってしまって、デバッグが面倒に。

ま、ループで何万回も廻すでもない限り、大きな差は出ないだろうから、このままでいいっすわ。