DBIx::Class::SchemaAccesser

DBIx::Class::SchemaAccesserなるものを作りました。
ラボで公開ちう。
http://code.mfac.jp/trac/browser/CPAN/nekokak/DBIx-Class-SchemaAccesser/

Catalystとかのフレームワークを使っている場合は
DBICのオブジェクトを毎回作るのはフレームワークのプラグインとかが
簡単＆ほぼ勝手にやってくれるからいいのですが、
コマンドラインのツールとかフレームワークにDBICのプラグインが無い時なんか
泣きそうになりませんか？私ならなります＞＜

ちょっとドラフト案ですが、DBIx::Class::SchemaAccesserなるものを作ってみまんた。
使い方は以下を参照のこと。
ご意見求む。datasourceあたりをもっと綺麗にできないかしら。

DBIx::Class::SchemaAccesserのソース

package DBIx::Class::SchemaAccesser;
use strict;
use warnings;
use UNIVERSAL::require;

our $VERSION = 0.01;

sub import {
    my ($class, $schema_base, $opts) = @_;
    my $pkg         = caller;
    my $datasource = $opts->{'datasource'};

    (my $base_name = $pkg) =~ s/(::.+)?$//g;
    my $schema_class = $base_name .'::'. $schema_base;
    $schema_class->use or die $@;

    {
        no strict 'refs'; ## no critic
        *{"$pkg\::_dbic_connect"} = \&_connect;
        *{"$pkg\::model"} = sub {
            my ($self, $schema) = @_;

            $self->{__DBIC_SCHEMA} ||= $self->_dbic_connect($schema_class,$datasource);

            if ($schema) {
                return $self->{__DBIC_SCHEMA}->resultset($schema);
            } else {
                return $self->{__DBIC_SCHEMA};
            }
        };
    }
}

sub _connect {
    my ($self,$schema_class,$connection_info) = @_;
    my $schema = $schema_class->connect(@$connection_info);
    return $schema;
}

1;

サンプル（DBIx::Class::SchemaAccesserのPODと同じ）

#! /usr/bin/perl
use strict;
use warnings;

my $obj = TestDBIC::TestMan->new;
$obj->run;

package TestDBIC::TestMan;
use base qw/Class::Accessor::Fast/;
use DBIx::Class::SchemaAccesser
    'Schema',
    {'datasource' => [
        'dbi:mysql:test_dbic',
        'test_man',
        'testtest'
    ]},
;

sub run {
    my $self = shift;
    my $member_ite = $self->model('Member')->search;
    while (my $member = $member_ite->next) {
        print $member->id,"\n";
    }
}
1;

package TestDBIC::Schema::Member;
use strict;
use warnings;
use base 'DBIx::Class';

__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('member');
__PACKAGE__->add_columns(
    qw/
        id
        rid
        name
        created_on
        timestamp
    /
);
__PACKAGE__->set_primary_key('id');

1;

package TestDBIC::Schema;
use strict;
use warnings;
use base 'DBIx::Class::Schema';

__PACKAGE__->load_classes( );

1;

色々ご意見頂けるとうれしいです。