Perl

Perlの勧め(2) Class::DBIを使おう

onagatani 2009年05月11日

こんにちわ　onagataniことナガタニです。
Perlの勧め１は読んでもらえましたでしょうか。
弊社ディレクター陣からは意味分からんといわれてしまい、
ちと初心者向けではなかったのかなぁと思っております。

今回の２回目ではPerlのORマッパーの代表格であるClass::DBIを紹介します。
説明に入る前にPerlのORマッパーの個人的な感想を。。。

Class::DBI 歴史も古く枯れている
DBIx::Class 最も人気のあるORマッパー非常に高機能
Data::ObjectDriver　MTから切り離されてCPANに登録されたORマッパー。標準でキャッシュやパーティショニングが可能。
DBIx:MoCo とても簡単にキャッシュが可能。rubyちっくな配列処理

それぞれ特徴がありますが、お気楽に使うならClass::DBIが枯れていて情報も沢山あるため個人的にはお勧めです。
その代わり古いモジュールなのでMoCoのように簡単にキャッシュはできないです。

基本的にどのデータベースエンジンでも問題ないはずですが今回はMySQLを使用します。

基本設定

まずデータベースに接続するためのベースクラスを作成します。
今回はClass::DBIをよりMySQL上で簡単に扱えるClass::DBI::mysqlを使用します。

package MyData::Base;
use strict;
use base qw(Class::DBI::mysql);
__PACKAGE__->set_db('Main', "dbi:mysql:$DBNAME", $DBUSER, $DBPASS);
1;
__END__

次に実際にテーブルを操作するためにテーブル毎にクラスを作成します。
今回はブログテーブルとエントリーテーブルを例に作成します。

・Blogテーブルのクラス

package MyData::Blog;
use strict;
use base qw/MyData::Base/;

__PACKAGE__->table('blog');
__PACKAGE__->create_table(q{
  `id` int(10) unsigned NOT NULL auto_increment,
  `title` varchar(255) NOT NULL,
  `description` varchar(255) NOT NULL,
  `created_at` datetime NOT NULL,
  `updated_at` datetime NOT NULL,
  PRIMARY KEY  (`id`)
});
__PACKAGE__>set_up_table;
1;
__END__

・Entryテーブルのクラス


package MyData::Entry;
use strict; 
use base qw/MyData::Base/;

__PACKAGE__->table('entry');
__PACKAGE__->create_table(q{
  `id` int(10) unsigned NOT NULL auto_increment,
  `blog_id` int(10) unsigned NOT NULL,
  `title` varchar(255) NOT NULL,
  `text` text NOT NULL,
  `created_at` datetime NOT NULL,
  `updated_at` datetime NOT NULL,
  PRIMARY KEY  (`id`),
  KEY `flag` (`blog_id`)
});
__PACKAGE__->set_up_table;
1;
__END__

上記クラスでは、テーブルが存在しない場合create_tableでテーブルを作成します。

仕様例

スクリプト内で各テーブルのクラスをuseしておきます。
use MyData::Blog;
use MyData::Entry;

例1）プライマリキーで検索する

my $blog = MyData::Blog->retrieve('1');
$blog->title; #プライマリキー１のtitle

例2) 全件取得する

my $blogs = MyData::Blog->retrieve_all;
$で受け取るとイテレータ
@で受け取るとレコードが配列になって受け取れます。
イテレータの場合は、
while (my $blog = $blogs->next) {
say $blog->title;
}
このように使用します。

例2) 複数条件で検索する

my @entrys = MyData::Entry->search(blog_id => '1', title => 'hoge');
*イテレータでも受け取れます

例3) like検索

my @entrys = MyData::Entry->search_like(title => 'hoge%');
*イテレータでも受け取れます

例4）データベースとメモリから削除

my $blog = MyData::Blog->retrieve('1');
$blog->delete;

例5）データベースとメモリに格納

my $entry = MyData::Entry->create({
blog_id => '1',
title => 'hoge',
text => 'fuga',
});

例6）更新する

my $blog = MyData::Blog->retrieve('1');
$blog->title('fuga');
$blog->update;

リレーションの設定

上記のテーブルのように２つのテーブルで外部キーによるリレーションを行う場合には
下記の設定でblog_idを引いた時に、MyData::Blogのオブジェクトに(インフレート)する事ができます。

package MyData::Entryに以下を追加します。
__PACKAGE__->has_a(blog_id => 'MyData::Blog');

例1）外部キーによるインフレート

my $entry = MyData::Entry->retrieve(1);
my $blog = $entry->blog_id; #blog_idからblogオブジェクトを取得
say $blog->title; #blogのtitleを表示

インフレート

has_aを使用するとリレーションと同じようにカラムを別のオブジェクトに(インフレート)する事ができます。

例1）created_atをDateTimeオブジェクトにインフレートする

package MyData::Entry MyData::Blogに以下を追加します。

use DateTime::Format::MySQL;
__PACKAGE__->has_a(created_at => 'DateTime',
inflate => sub {
return DateTime::Format::MySQL->parse_datetime( shift );
},
);

トリガ

各フックポイントにコードレフを与えて処理を追加します。

例1）create_atやupdated_atを自動で入力(更新)させます。

package MyData::Blog に以下を追加します。

use DateTime;
__PACKAGE__->add_trigger(
    before_create => sub {
        my $self = shift;
        my $now = DateTime->now( time_zone => "local")->strftime('%Y-%m-%d %H:%M:%S');
        $self->_attribute_set(created_at => $now);
        $self->_attribute_set(updated_at => $now);
    },
);
__PACKAGE__->add_trigger(
    before_update => sub {
        my $self = shift;
        my $now = DateTime->now( time_zone => "local")->strftime('%Y-%m-%d %H:%M:%S');
        $self->updated_at($now);
    },
);

以上

ざっくり書きました。
ここに書いた以外にも沢山の便利メソッドがあるので調べてみてください。
日本語の情報もおおいです。

サンプルを置いておくのでご覧ください。 *スクリプトの動作保証は致しません。

おかしな書き方ありましたら、ご意見お願いします。

＜追記＞

とある方からご意見頂きました。
Class::DBIにもデメリットがあるので、そのあたりは調べてから使用した方がよいかもしれません(最新のORマッパーの方が高機能ですしね)。

投稿者 onagatani : 05/11

Perlの勧め（1） Class::Accessor::Fastを使おう

onagatani 2009年04月10日

onagataniですこんにちわ。

今回から数回に分けて自分のお勧めするモジュールを紹介したいと思います。

内容がモダンじゃない！と思う方もいるかもですが自分の好きなモジュールを紹介しますので最新の技術が知りたい方は見ないように...。

一回目は「Class::Accessor::Fast」です。

これはなにかというとPerlでアクセサを自動生成するモジュールです。

たとえば、下記のような場合にとても便利です。

MyClass.pm

package MyClass;

use strict;
use warnings;

sub new {
    my ($class, $args) = @_;
    my $self = {
        address => $args{address},
        blog       => $args{blog},
    };
    return bless $self, $class;
}

sub address {
    my ($self, $address) = @_; 
    if ($address){
        $self->{address} = $address;
    }   
    return $self->{address};
}

sub blog {
    my ($self, $blog) = @_; 
    if ($blog){
        $self->{blog} = $blog;
    }   
    return $self->{blog};
}

1;
__END__

これを

package MyClass;

use strict;
use warnings;
use base qw/Class::Accessor::Fast/;

__PACKAGE__->mk_accessors(qw/ address blog /);

1;
__END__

このように書くことができます。
アクセサを自動生成するほかにnewメソッドも作ってくれるのでとっても便利。
（newはほとんどの場合オーバーライドすることになると思いますが）

使い方も一緒です。

#!/usr/bin/perl

use strict;
use warnings;
use MyClass;
use Perl6::Say;

my $obj = MyClass->new({
    address => 'tokyo',
    blog    => 'wordpress',
});

say $obj->address;
say $obj->blog;

$obj->address('obihiro');
$obj->blog('mt');
say $obj->address;
say $obj->blog;

結果
perl test.pl
tokyo
wordpress
obihiro
mt

というわけでコードも短くなるし読みやすくなるのでお勧めします。

投稿者 onagatani : 04/10

前の5件