URI.pm っぽいモジュール名用クラス

を考えてみました。

use Module::Class;

Module::Class->module('CGI')->require  or  die $@;

それ UNIVERSAL::require (ry

というのは冗談ですが

# with Module::Class::Plugin::Module::CoreList;

print Module::Class->module('File::Spec')->first_release();

みたいにプラグインで拡張できるもの。

なぜ Module::Name という名前じゃないかというと

Module::Class->modules(qw( CGI HTTP::Request ))->require()  or  die $@;

Module::Class->module('HogeHoge')->findsubmod()->require();

みたく配列とか他のモジュールの戻り値を活用できたらおもしろいかな，と（今回はそこまでインプリメントしてません）。てか Path::Class インスパイアドなだけです。

CPAN になさそうだし，なんとなく必要になって書いてみたんですが，いざ書いてみたら使い道がなかったです。でも Object::Declare について勉強になったからいいや。

package Module::Class;

use strict;
use warnings;

use overload
    q{""}    => sub { ${$_[0]} },
    q{==}    => sub { overload::StrVal($_[0]) eq overload::StrVal($_[1]) },
    fallback => 1;

use Module::Pluggable
    require => 1;

BEGIN { __PACKAGE__->plugins() }  # load plugins

sub module {
    my ($class, $module) = @_;
    return bless \$module, $class;
}

1;

package Module::Class::Plugin;

use strict;
use warnings;
use Exporter::Lite;
use UNIVERSAL::require;

our @EXPORT = qw( from methods method );

use Object::Declare
    declarator => 'methods',
    copula     => {
        is => sub { is => @_ },
        as => sub { as => @_ },
    },
    mapping    => {
        method => sub { return { @_ }; },
    },
;

sub from {
    my ($module, %methods) = @_;
    return if ! $module->require;

    while (my ($method, $args) = each %methods) {
        my $method_in_module = defined $args->{as} ? $args->{as} : $method;

        if ($args->{is} eq 'class_method') {
            my $sub = sub {
                          my $self = shift;
                          return $module->$method_in_module($$self, @_);
                      };

            no strict 'refs';
            *{"Module::Class::${method}"} = $sub;
        }
    }
}

1;

プラグインの例

package Module::Class::Plugin::require;

use strict;
use warnings;
use UNIVERSAL::require;

sub Module::Class::require {
    my $self = shift;
    return UNIVERSAL::require($$self, @_);
}

1;

package Module::Class::Plugin::Module::CoreList;

use strict;
use warnings;

use Module::Class::Plugin;

BEGIN {

from 'Module::CoreList', methods {
    method first_release =>
        is class_method;
    method first_release_by_date =>
        is class_method;
};

}

1;