日向夏特殊応援部隊

俺様向けメモ

DBIC::Schema::Loaderのカスタマイズと言うネタでプレゼンするはずだった件

Perl DBIC

話してないけど、資料はあるので公開しまっする。

概要

開発中にスキーマに変更が発生して、make_schema_at()を何度も叩く際に困ることと、Schema::Loaderで比較的意図した通りにSchema, Tableクラスを生成する為に、こんな風にするといいおって内容です。

せっかちな人向け

こんな感じ。
内容の解説はプレゼン資料を見てくだしあ。

#!/usr/bin/perl

use strict;
use warnings;

use FindBin;
use File::Spec;
use lib (
    File::Spec->catfile( $FindBin::Bin, qw/.. lib/ ),
    File::Spec->catfile( $FindBin::Bin, qw/.. schema/ )
);
use DBIx::Class::Schema::Loader qw(make_schema_at);

die unless @ARGV;

my $schema_class = 'MyClass::DBIC::Schema';

unlink(
    glob(
        File::Spec->catdir( $FindBin::Bin, '..', 'lib',
            split( /::/, $schema_class ) )
            . '/*.pm'
    )
);

use DBIx::Class::Schema::Loader::Base;
package DBIx::Class::Schema::Loader::Base;

use String::CamelCase qw(decamelize);

{
    no warnings 'redefine';

    sub _load_relationships {
        my ( $self, $table ) = @_;

        my $tbl_fk_info = $self->_table_fk_info($table);
        foreach my $fkdef (@$tbl_fk_info) {
            $fkdef->{remote_source}
                = $self->monikers->{ delete $fkdef->{remote_table} };
        }

        my $local_moniker = $self->monikers->{$table};
        my $rel_stmts     = $self->{relbuilder}
            ->generate_code( $local_moniker, $tbl_fk_info );

        foreach my $src_class ( sort keys %$rel_stmts ) {
            my $src_stmts = $rel_stmts->{$src_class};
            foreach my $stmt (@$src_stmts) {
                if ($stmt->{method} eq 'belongs_to') {
                    my $table_class_suffix = [split /::/ => $stmt->{args}->[1]]->[-1];
                    $stmt->{args}->[0] = decamelize($table_class_suffix);
                }

                $self->_dbic_stmt( $src_class, $stmt->{method},
                    @{ $stmt->{args} } );
            }
        }
    }
}

package main;

make_schema_at(
    $schema_class,
    {   components => [
            qw/ResultSetManager UTF8Columns InflateColumn::DateTime TimeStamp /
        ],
        dump_directory => File::Spec->catfile( $FindBin::Bin, qw/.. lib/ ),
        debug          => 0,
        really_erase_my_files => 0,
        exclude               => qr/Base$/,
    },
    \@ARGV,
);

まぁ、俺様Loader作るないしはDBICを使わないのがベストプラクティスな気がします。(冗談だけど)

SEE ALSO