良くあるDBICのサンプルではDBIx::Class::Schema::load_classes()を使ってクラスのロードを行っています。

CD.pm
package CD;

use strict;
use warnings;

use base 'DBIx::Class::Schema';

__PACKAGE__->load_classes;
1;
load_classes()はクラスを指定しないと
CD
    Album
    Track

という構成において自動的にクラスをロードすることができます。

ここでResultSetの拡張をしたいと考えます。例えば

CD/ResultSet/Album.pm
package CD::ResultSet::Album;

use strict;
use warnings;

use base 'DBIx::Class::ResultSet';

sub search_order_title {
    my $self = shift;

    return $self->search({}, {'order_by' => 'title'});
}
1;

のようにDBIx::Class::ResultSetを継承したクラスを作ってCD::Album::resultset_class()でロードします。ここで問題になるのがこのクラスのネームスペースをどうするかという点です。

CD::ResultSet::*にしてしまうと、load_classes()でwarningが出る羽目になります。かといってload_classes(qw/Album Track/)などとクラスを指定するのもクラスが増えてきたときに大変そうです。またはResultSet::CD::AlbumのようにCDより上のネームスペー>スを使うのも、あんまりいけてない感じです。

そこでDBIC::Schemaにはもう一つクラスのロード手段としてload_namespaces()が用意されていているのこれを使います。

CD.pm
package CD;

use strict;
use warnings;

use base 'DBIx::Class::Schema';

__PACKAGE__->load_namespaces;
1;

load_namespaces()はデフォルトで

CD
    Result
        Album
        Track
    ResultSet
        Album

という構成をとります。

これのメリットはネームスペースがすっきりするだけではなく、ResutlSet::*にResutl::*と同じ名前のResutlSetクラスを作ると、Resultクラスでresutlset_class()で指定しなくても自動的にロードしてくれる点です。(ただ逆もまたしかりで、上の構成でResultSet::Hogeなどを作ると対応するResultクラスがないとwarningがでます。)

ちなみにDBIx::Class::Schema::Loaderを使ってデータベースからクラスを起こす場合は
perl -MDBIx::Class::Schema::Loader=make_schema_at,dump_to_dir:./lib -e 'make_schema_at "CD", {use_namespaces => 1, debug => 1}, ["dbi:SQLite:cd.db","",""]'
のようにuse_namespacesオプションを指定するといいです。

今回のコード

CD.pm
package CD;

use strict;
use warnings;

use base 'DBIx::Class::Schema';

__PACKAGE__->load_namespaces;
1;
CD/Result/Album
package CD::Result::Album;

use strict;
use warnings;

use base 'DBIx::Class';
__PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('album');
__PACKAGE__->add_columns(
    id => {
        data_type         => 'INTEGER',
        size              => 11,
        is_nullable       => 0,
        is_auto_increment => 1,
    },
    title => {
        data_type   => 'VARCHAR',
        size        => '255',
        is_nullable => 0,
    },
);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->has_many(
    tracks => 'CD::Result::Track', 'album_id', {order_by => 'position'}
);
1;
CD/Result/Track.pm
package CD::Result::Track;

use strict;
use warnings;

use base 'DBIx::Class';
__PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('track');
__PACKAGE__->add_columns(
    id => {
        data_type         => 'INTEGER',
        size              => 11,
        is_nullable       => 0,
        is_auto_increment => 1,
    },
    album_id => {
        data_type   => 'INTEGER',
        size        => 11,
        is_nullable => 0,
    },
    position => {
        data_type   => 'TINYINT',
        size        => 1,
        is_nullable => 0,
    },
    title => {
        data_type   => 'VARCHAR',
        size        => '255',
        is_nullable => 0,
    },
);
__PACKAGE__->set_primary_key('id');
__PACKAGE__->add_unique_constraint(
    track_uq_album_id_position => [qw/album_id position/]);
__PACKAGE__->belongs_to(album => 'CD::Result::Album', 'album_id');
1;
CD/ResultSet/Album
package CD::ResultSet::Album;

use strict;
use warnings;

use base 'DBIx::Class::ResultSet';

sub search_order_title {
    my $self = shift;

    return $self->search({}, {'order_by' => 'title'});
}
1;
              

              

トラックバック(0)

トラックバックURL: http://mt.hide-k.net/mt-tb.cgi/790

コメントする

プロフィール

このブログ記事について

このページは、hideが2009年6月 2日 18:46に書いたブログ記事です。

ひとつ前のブログ記事は「ディストリビューションにおけるPerl 5.10の普及率」です。

次のブログ記事は「コードの世界」です。

最近のコンテンツはインデックスページで見られます。過去に書かれたものはアーカイブのページで見られます。