Catalyst::Model::Loader

思うところがあって複数のPOPOモデルを読み込んでCatalystのModelにするLoaderを作ってみた。パッケージ名がなんかしっくりこないけれど。

package Catalyst::Model::Loader;
use strict;
use warnings;
use Class::C3;

our $VERSION = '0.01';
use base 'Catalyst::Model::Loader::Base';

sub new {
    my $class = shift;
    my $self  = $class->next::method(@_);
    $self->load_services;
    $self;
}

1;

package Catalyst::Model::Loader::Base;
use strict;
use warnings;
use Carp;
use Class::C3;
use Sub::Install;
use Module::Pluggable::Object;
use UNIVERSAL::require;
use base 'Catalyst::Model';

sub load_services {
    my $self       = shift;
    my $base_class = $self->{base_class};
    croak 'base_class is required !!!' unless $base_class;
    my $finder = Module::Pluggable::Object->new( search_path => $base_class );
    foreach my $service ( $finder->plugins ) {
        $self->_install_service_as_model($service);
    }
}

sub _install_service_as_model {
    my ( $self, $service ) = @_;
    my $classname
        = $self->_convert2classname( $service, $self->{base_class} );
    my $instance = $self->_create_instance($service);
    Sub::Install::install_sub(
        {   code => sub { return $instance },
            into => $classname,
            as   => 'ACCEPT_CONTEXT',
        }
    );
}

sub _convert2classname {
    my ( $self, $service, $base_class ) = @_;
    my $class              = ref($self);
    my $short_service_name = $service;
    $short_service_name =~ s/^$base_class\:\://g;
    return "${class}::$short_service_name";
}

sub _create_instance {
    my ( $self, $adapted_class ) = @_;
    my $constructor = $self->{constructor} || 'new';
    $adapted_class->require;
    return $adapted_class->$constructor();
}

1;

__END__

# 作ってみたら、コードは違うけれど、機能的にはCatalyst::Model::DynamicAdapterと同じになってる.