MoFedge::Data::DBIC::Schema::Loader

今までMoFedge::Data::DBIC::Schemaを使う時は、
以下のような感じでした。

package TestDBIC::Schema;
use strict;
use warnings;
use base qw(MoFedge::Data::DBIC::Schema);

__PACKAGE__->load_classes( );

1;

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

__PACKAGE__->table('member');
__PACKAGE__->add_columns(
    qw/
        id
        rid
        name
        created_on
        timestamp
    /
);

1;

こんな感じにスキーマが増えると、対応するモジュールを作ってました。
tableを指定したりadd_columnsを手動で設定していました。

DRYとかなんだとか言うつもりはないのですが、
まあLoaderあるならつかっとけと。
昔より早くなったとのうわさもどっかで聞いたので。
で、MoFedge::Data::DBIC::Schema::Loaderを作りました。
MoFedge::Data::DBIC::Schema::Loaderを使うと、

package TestDBIC::SchemaL;
use strict;
use warnings;
use base qw/MoFedge::Data::DBIC::Schema::Loader/;

__PACKAGE__->mofedge_model_setup;

1;

たったこれだけでよくなります。

MoFedge::Data::DBIC::Schema::Loaderのソース。

package MoFedge::Data::DBIC::Schema::Loader;
use strict;
use warnings;
use base qw/MoFedge DBIx::Class::Schema::Loader/;

use UNIVERSAL::require;
use Switch;
use Lingua::EN::Inflect;

our $VERSION = '0.01';

sub mofedge_model_setup {
    my $class = shift;

    $class->loader_options(
        relationships => 0,
        debug         => 0,
    );

    $class->connection( $class->config->datasource );

    for my $source_moniker ($class->sources) {

        #load_components
        my $schema_class = "$class\::$source_moniker";
        $schema_class->load_components(qw/
            +MoFedge::Data::DBIC::AutoSet
            +MoFedge::Data::DBIC::FromSledge
            +MoFedge::Data::DBIC::AutoInflateDateTime
            StorageReadOnly
            DigestColumns::Lite
            AsFdat
        /);

        my $source = $class->class($source_moniker);
        my @ordered_sources = $class->_ordered_sources;
        for my $column ( $source->columns ) {

            switch ($column) {
                case /^created_on$/ { $schema_class->datetime_column($column)                          }
                case /^updated_on$/ { $schema_class->datetime_column($column)                          }
                case /_on$/         { $schema_class->date_column($column)                              }
                case /_at$/         { $schema_class->datetime_column($column)                          }
                case 'id'           { $schema_class->resultset_attributes({ order_by => 'me.id DESC'}) }
                case /^(.+)_id$/    {
                    (my $column_head = $column) =~ s/^(.+)_id$/$1/g;
                    $class->_auto_relationship(\@ordered_sources, $source, $column, $column_head);
                }
            }
        }
    }
}
sub _auto_relationship {
    my ($class, $ordered_sources, $source, $column, $column_head) = @_;

    for my $foreign_source (@$ordered_sources) {
        if ($column_head =~ $foreign_source->table) {

        $source->belongs_to($column, $foreign_source);

            # $self->user_id => $self->user
            no strict 'refs'; ## no critic
            *{"$source\::$column_head"} = *{"$source\::$column"};

            $foreign_source->has_many(Lingua::EN::Inflect::PL($source->table), $source, $column);

            last;
        }
    }
}

# sort sources order by table name length.
sub _ordered_sources {
    my $class = shift;

    return          map  { $_->[0] }
            reverse sort { $a->[1] <=> $b->[1] }
                    map  { [ $_, length($_->table)] }
                    map  { $class->class($_) }
                         $class->sources;
}

1;

こんな感じ、多くのメソッドはMoFedge::Data::DBIC::Schemaから持ってきています。
これで大分とらくちんに開発できるとおもわれ。
まあ、さっき作ったばかりでまだまだ改善の余地はあるですが。

これだとMoFedge::Plugin::DBICとか使えないしね。
TODOとしてはまずはそこかねちみ。

(追記)
MoFedge::Plugin::DBICはこのままで問題なげな予感。