DBIx::Class::Loader::Oracle 作りました（多分ちゃんと動いてる・・・）

Catalyst の Model に Class::DBI でなくて DBIC 試してみようと思ったら、DBIx::Class::Loader::Oracle がないので Helper スクリプトがエラーになってしまいます。

 script/test_create.pl model DBIC DBIC dbi:Oracle:testdb test test123
 exists "/test/script/../lib/test/Model"
 exists "/test/script/../t"
This module has been deprecated in favor of Catalyst::Model::DBIC::Schema at /usr/local/lib/perl5/site_perl/5.8.6/Catalyst/Helper/Model/DBIC.pm line 45.
 exists "/test/script/../lib/test/Model/DBIC.pm"
created "/test/script/../lib/test/Model/DBIC.pm.new"
Couldn't require loader class "DBIx::Class::Loader::Oracle", "Can't locate DBIx/Class/Loader/Oracle.pm in @INC (@INC contains: /usr/local/lib/perl5/5.8.6/x86_64-linux-thread-multi /usr/local/lib/perl5/5.8.6 /usr/local/lib/perl5/site_perl/5.8.6/x86_64-linux-thread-multi /usr/local/lib/perl5/site_perl/5.8.6 /usr/local/lib/perl5/site_perl .) at /usr/local/lib/perl5/site_perl/5.8.6/DBIx/Class/Loader.pm line 106.
" at /usr/local/lib/perl5/site_perl/5.8.6/Catalyst/Helper/Model/DBIC.pm line 57

調べてみたら、DBIx::Class::Loader が何故か Oracle だけサポートしてません。欲しいので（ってか必要なので）作ってみました。使い込んでいないのでバギーかもしれませんが。

ダウンロードはこちら　→　DBIx-Class-Loader-Oracle-0.01.tar.gz
Schema-Loader も作りました　→　DBIx-Class-Schema-Loader-Oracle-0.01.tar.gz

ソースはこんな感じ。Class::DBI::Loader::Oracle 0.01 を参考に作ってます。

package DBIx::Class::Loader::Oracle;

use strict;
use base 'DBIx::Class::Loader::Generic';
use Carp;

sub _db_classes {
    return qw/DBIx::Class::PK::Auto::Oracle/;
}

sub _db_class { return 'Class::DBI::Oracle' }

sub _tables {
    my $self = shift;
    my $dbh = $self->{storage}->dbh;
    my @tables;
    for my $table ( $dbh->tables(undef, $self->{_schema}, '%', 'TABLE') ) { #catalog, schema, table, type
        my $quoter = $dbh->get_info(29);
        $table =~ s/$quoter//g;

        # remove "user." (schema) prefixes
        $table =~ s/\w+\.//;

        next if $table eq 'PLAN_TABLE';
        $table = lc $table;
        push @tables, $1
          if $table =~ /\A(\w+)\z/;
    }
    return @tables;
}

sub _table_info {
    my ( $self, $table ) = @_;
    my $dbh = $self->{storage}->dbh;

    my $sth = $dbh->column_info(undef, $self->{_schema}, uc $table, undef);
    my @cols = map { lc $_->[3] } @{ $sth->fetchall_arrayref };
    s/"//g for @cols;
    
    my @primary = $dbh->primary_key(undef, $self->{_schema}, uc $table);
    @primary = map{ lc $_ } @primary;
    s/"//g for @primary;

    return ( \@cols, \@primary );
}

sub _relationships {
    my $self = shift;
    foreach my $table ( $self->tables ) {
        my $dbh = $self->{storage}->dbh;
        my $quoter = $dbh->get_info(29) || q{"};
        if ( my $sth = $dbh->foreign_key_info( '', $self->{schema}, '', '', '', uc $table ) ) {
            for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) {
                my $column = lc $res->{FK_COLUMN_NAME};
                my $other  = lc $res->{UK_TABLE_NAME};
                my $other_column  = lc $res->{UK_COLUMN_NAME};
                $column =~ s/$quoter//g;
                $other =~ s/$quoter//g;
                $other_column =~ s/$quoter//g;
                eval { $self->_belongs_to_many( $table, $column, $other,
                  $other_column ) };
                warn qq/\# belongs_to_many failed "$@"\n\n/
                  if $@ && $self->debug;
            }
        }
    }
}

1;

Catalyst の Model 標準が DBIC になりつつあるらしいですが、CDBI と DBIC の違いを理解しきってません。DBIC の内部実装の方が速度を気にしながら実装しているというはどこかで見かけましたし、ベンチも実際速いみたいです。

CDBI から移行する時にメンドウなので、DBIx::Class::CDBICompat を使っちゃえってすると、パフォーマンスがすごく悪くなるそうなので注意ですね。

あっ、今気がつきましたが、今後は DBIx::Class::Schema::Loader ベースになるんでしたっけ？しまったなぁ・・・

__追記(06.05.29)__
DBIx-Class-Schema-Loader-Oracle-0.01 も作りました。よろしければどうぞ。

ちなみに、動作検証のテストスクリプトはこんな感じ。

use strict;
use warnings;
use Data::Dumper;
use DBIx::Class::Loader;

my $loader = DBIx::Class::Loader->new(
    dsn                     => "dbi:Oracle:testdb",
    user                    => "test",
    password                => "test123",
    namespace               => "data",
    relationships           => 1,
    debug                   => 1,
    schema                  => 'TEST',
);
my @tables = $loader->tables;
print Dumper(\@tables);