DB 処理における Fixture テストの勧め

自己紹介

今回のお題

昨日は割と概念的なお話ばかりだったので、今回は具体的な話メインで行きたいと思います。 やはりプログラミングにはバグがつきもので、それを防ぐにはテストを書くしかないですよね、と言う事でテストにまつわるお話です。

とは言っても今日のこのイベントに来ている人は Test::More でのテストなどは書いた事がある人が多いと思うので、Test::More の説明は割愛します。

まずは Test::mysqld の使い方

とりあえず、手元の環境に mysql をインストールしておきます。Q4M も使いたい場合は Q4M のビルドもしておくといいです。

さて、試しに Test::mysqld を使ってみましょう。 

#!/usr/bin/perl

use strict;
use warnings;

use Carp;
use Data::Dump qw(dump);
use Test::mysqld;
use DBIx::Connector;
use SQL::SplitStatement;
use SQL::Abstract::Limit;
use SQL::Abstract::Plugin::InsertMulti;

our $VERSION = 0.01;

### mysqld の起動
my $mysqld =
  Test::mysqld->new( +{ my_cnf => +{ 'skip-networking' => undef, } } )
  or die($Test::mysqld::errstr);

### DBIx::Connector を作る。new の引数は DBI->connect と同じ
my $conn =
  DBIx::Connector->new( $mysqld->dsn(), '', '',
    +{ ShowErrorStatement => 1, RaiseError => 1, AutoCommit => 0, } );
### SQL::Abstract::Limit + SQL::Abstract::Plugin::InsertMulti
my $sql = SQL::Abstract::Limit->new( limit_dialect => 'LimitOffset' );

### テーブルの作成
$conn->run(
    fixup => sub {
        my $dbh            = shift;
        my $sql_statements = <<'SQL';
CREATE DATABASE hokkaido;
USE hokkaido;
CREATE TABLE people (
  id int(10) primary key not null auto_increment,
  name varchar(32) not null,
  created_on date NOT NULL,
  updated_on date NOT NULL
) ENGINE=InnoDB;
SQL
        my $splitter = SQL::SplitStatement->new(
            keep_terminator      => 1,
            keep_comments        => 0,
            keep_empty_statement => 0,
        );
        for ( $splitter->split($sql_statements) ) {
            $dbh->do($_) or die( $dbh->errstr );
        }
    }
);

### レコード挿入
$conn->txn(
    fixup => sub {
        my $dbh = shift;
        my ( $stmt, @bind ) = $sql->insert_multi(
            'people',
            [qw/name created_on updated_on/],
            [
                map { [ $_, \'NOW()', \'NOW()' ] }
                  qw/lestrrat shebang zigorou milano daiba oyama/
            ]
        );
        $dbh->do( $stmt, undef, @bind ) or croak( $dbh->errstr );
        $dbh->commit or croak( $dbh->errstr );
    }
);

### データ取得
my $rs = $conn->run(
    fixup => sub {
        my $dbh = shift;
        my ( $stmt, @bind ) = $sql->select(
            'people',
            [qw/id name created_on updated_on/],
            +{ id => \'% 2 = 1', }
        );
        $dbh->selectall_arrayref( $stmt, +{ Slice => +{} }, @bind );
    }
);

warn dump($rs);

辺りはうちでは結構使ってます。

Test::mysqld では事実上 my.cnf の mysql セクションに書ける事は何でも書けます。

例えばレプリケーションするとか

現実的にここまでやってテストする必要があるかはケースバイケース。 ちなみに僕らはそこまでやってません＞＜ 

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dump qw(dump);
use DBI;
use Test::More;
use Test::Exception;
use Test::mysqld;
use Test::TCP;

sub setup_master {

# http://dev.mysql.com/doc/refman/5.1/en/replication-howto-masterbaseconfig.html
    my $mysqld = Test::mysqld->new(
        auto_start => 2,

        # mysqld     => '/usr/sbin/mysqld',
        my_cnf => +{
            'port'      => empty_port(),
            'log-bin'   => 'mysql-bin',
            'server-id' => 1,
        },
    ) or die($Test::mysqld::errstr);

    note( $mysqld->dsn );

    # http://dev.mysql.com/doc/refman/5.1/en/replication-howto-repuser.html
    my $dbh = DBI->connect( $mysqld->dsn, 'root', '' );
    $dbh->do(
        sprintf(
            q|CREATE USER '%s'@'%s' IDENTIFIED BY '%s'|,
            'repl', '127.0.0.1', 'replpass'
        )
    ) or die( $dbh->errstr );
    $dbh->do(
        sprintf(
            q|GRANT REPLICATION SLAVE ON *.* TO '%s'@'%s'|,
            'repl', '127.0.0.1'
        )
    ) or die( $dbh->errstr );

    return $mysqld;
}

sub setup_slave {
    my $master_mysqld = shift;

 # http://dev.mysql.com/doc/refman/5.1/en/replication-howto-slavebaseconfig.html
    my $mysqld = Test::mysqld->new(
        auto_start => 2,

        # mysqld     => '/usr/sbin/mysqld',
        my_cnf => +{
            'port'      => empty_port(),
            'server-id' => 2,
        },
    ) or die($Test::mysqld::errstr);

    note( $mysqld->dsn );

    my $dbh_master = DBI->connect( $master_mysqld->dsn, 'root', '' );

    my $master_status = $dbh_master->selectrow_hashref('SHOW MASTER STATUS');

    my $dbh = DBI->connect( $mysqld->dsn, 'root', '' );

    # http://dev.mysql.com/doc/refman/5.1/en/replication-howto-slaveinit.html
    $dbh->do(
        sprintf(
q|CHANGE MASTER TO MASTER_HOST='%s', MASTER_PORT=%d, MASTER_USER='%s', MASTER_PASSWORD='%s', MASTER_LOG_FILE='%s', MASTER_LOG_POS=%d|,
            '127.0.0.1',            $master_mysqld->my_cnf->{port},
            'repl',                 'replpass',
            $master_status->{File}, $master_status->{Position},
        )
    );
    $dbh->do(q|START SLAVE|);

    note(
        explain(
            $dbh->selectall_arrayref( 'SHOW SLAVE STATUS', +{ Slice => +{} } )
        )
    );

    return $mysqld;
}

my $master_mysqld;

lives_ok(
    sub {
        $master_mysqld = setup_master;
    },
    'setup_master() is success'
);

my $slave_mysqld;

lives_ok(
    sub {
        $slave_mysqld = setup_slave($master_mysqld);
    },
    'setup_slave() is success'
);

my $dbh_master =
  DBI->connect( $master_mysqld->dsn, 'root', '',
    +{ RaiseError => 1, AutoCommit => 0, } );

isa_ok( $dbh_master, 'DBI::db' );

$dbh_master->do(q|CREATE DATABASE hidek|) or die( $dbh_master->errstr );
$dbh_master->do(q|USE hidek|)             or die( $dbh_master->errstr );
$dbh_master->do(
q|CREATE TABLE hidek ( id int not null primary key auto_increment, name varchar(32) ) ENGINE=InnoDB|
) or die( $dbh_master->errstr );
$dbh_master->do( q|INSERT INTO hidek(name) VALUES(?)|, undef, 'yakatabune' )
  or die( $dbh_master->errstr );
$dbh_master->commit or die( $dbh_master->errstr );

note( explain( $dbh_master->selectall_arrayref(q|SHOW DATABASES|) ) );

sleep 10;

my $dbh_slave =
  DBI->connect( $slave_mysqld->dsn, 'root', '',
    +{ RaiseError => 1, AutoCommit => 0, } );

note( explain( $dbh_slave->selectall_arrayref(q|SHOW DATABASES|) ) );
$dbh_slave->do(q|USE hidek|);
note( explain( $dbh_slave->selectall_arrayref(q|SHOW TABLES|) ) );
note( explain( $dbh_slave->selectall_arrayref(q|SELECT * FROM hidek|) ) );

done_testing;

MySQL を使った Fixture テスト

例えば DBIC やら DBIx::Skinny だとかを使う場合はそれらに対応した Fixture モジュールがあるのでそちらを使うと幸せになれます。 うちの場合は O/R mapper は使わないので、仕方ないので Test::Fixture::DBI ってモジュールを作りました。 (今ちょっとテストがずっこけまくってるけど、そのうち直します＞＜)

O/R mapper の場合は schema 情報を通常クラスとして保持してますけど、DBI の場合はそうはいきません！

なので DBI で Fixture データを取り扱う場合は事前に database や table を作ってあげた上で、データを突っ込んでおかなければなりません。

さて、さっきのデータにちょっと毛が生えたような感じでテーブル定義を考えます。 

CREATE DATABASE hokkaido;
USE hokkaido;
DROP TABLE IF EXISTS people;
CREATE TABLE people (
  id int(10) primary key not null auto_increment,
  name varchar(32) not null,
  friends int(10) not null default 0,
  created_on date not null,
  updated_on date not null
) ENGINE=InnoDB;

INSERT INTO people(name, created_on, updated_on) 
VALUES( 'lestrrat', NOW(), NOW() ), ( 'shebang', NOW(), NOW() ), ( 'daiba', NOW(), NOW() ),
( 'oyama', NOW(), NOW() ), ( 'milano', NOW(), NOW() ), ( 'zigorou', NOW(), NOW() );

DROP TABLE IF EXISTS friends;
CREATE TABLE friends (
  id int(10) NOT NULL,
  friend_id int(10) NOT NULL,
  created_on date not null,
  updated_on date not null,
  primary key ( id, friend_id )
) ENGINE=InnoDB;

で、people.friends は友達の数が増えたらインクリメントされて減ったらデクリメントされるとしましょう。

こういうのは trigger を使うとちょっと便利です。 

DELIMITER ;
DROP TRIGGER IF EXISTS friends_on_after_insert;

DELIMITER //
CREATE TRIGGER friends_on_after_insert AFTER INSERT ON friends
FOR EACH ROW BEGIN
  UPDATE people SET friends = friends + 1 WHERE id = NEW.id;
END;
//

DELIMITER ;
DROP TRIGGER IF EXISTS friends_on_after_delete;

DELIMITER //
CREATE TRIGGER friends_on_after_delete AFTER DELETE ON friends
FOR EACH ROW BEGIN
  UPDATE people SET friends = friends - 1 WHERE id = OLD.id;
END;
//

DELIMITER ;

ここらへんで試しにデータを突っ込んでみて friends の値の増減を確かめます。

きっと動くだろうと思いますが、こういうのちゃんとテストしないと不安ですよね？ Test::Fixture::DBI では procedure/trigger のテストも出来るようになってます。 

$ make_database_yaml.pl -d "dbi:mysql:dbname=hokkaido" -u root
$ make_fixture_yaml.pl -d "dbi:mysql:dbname=hokkaido" -u root -t people

とかやってみると YAML にテーブル定義やトリガーやプロシージャの設定、またテーブルのレコードを取得する事が出来ます。

これらを取得した上で実際に Fixture を使ってみましょう。 

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dump qw(dump);
use Test::More;
use Test::Exception;
use Test::mysqld;
use Test::Fixture::DBI qw(:all);
use DBIx::Connector;
use SQL::Abstract::Limit;
use SQL::Abstract::Plugin::InsertMulti;

our $VERSION = 0.01;

my $mysqld =
  Test::mysqld->new( +{ my_cnf => +{ 'skip-networking' => undef, } } )
  or die($Test::mysqld::errstr);

my $conn =
  DBIx::Connector->new( $mysqld->dsn, '', '',
    +{ ShowErrorStatement => 1, RaiseError => 1, AutoCommit => 0, } );

my $sql = SQL::Abstract::Limit->new( limit_dialect => 'LimitOffset' );

$conn->run(
    fixup => sub {
        my $dbh = shift;
        $dbh->do('CREATE DATABASE hokkaido');
        $dbh->do('USE hokkaido');

        # table や procedure/function の初期化
        construct_database(
            dbh      => $dbh,
            database => './hokkaido.yaml'
        );

        # trigger の初期化
        construct_trigger(
            dbh      => $dbh,
            database => './hokkaido.yaml',
        );

        construct_fixture(
            dbh     => $dbh,
            fixture => ['./people_fixture.yaml'],
        );
    }
);

$conn = DBIx::Connector->new( $mysqld->dsn( dbname => 'hokkaido' ),
    '', '', +{ ShowErrorStatement => 1, RaiseError => 1, AutoCommit => 0, } );

subtest 'created tables' => sub {
    $conn->run(
        fixup => sub {
            my $dbh = shift;
            my $rs =
              $dbh->selectall_hashref( 'SHOW TABLES', 'Tables_in_hokkaido' );
            is( exists $rs->{people},  1, 'created table people' );
            is( exists $rs->{friends}, 1, 'created table friends' );
        },
    );
    done_testing;
};

sub create_friends {
    my ( $conn, $id, $friend_id ) = @_;
    $conn->txn(
        fixup => sub {
            my $dbh = shift;
            my ( $stmt, @bind ) = $sql->update_multi(
                'friends',
                [qw/id friend_id created_on updated_on/],
                [
                    [ $id,        $friend_id, \'NOW()', \'NOW()', ],
                    [ $friend_id, $id,        \'NOW()', \'NOW()', ]
                ],
                +{
                    update_ignore_fields => [ qw/id friend_id/ ]
                }
            );

            # note $stmt;
            # note explain \@bind;
            
            $dbh->do( $stmt, undef, @bind ) or croak( $dbh->errstr );
            $dbh->commit or croak( $dbh->errstr );
        },
    );
}

sub delete_friends {
    my ( $conn, $id, $friend_id ) = @_;
    $conn->txn(
        fixup => sub {
            my $dbh = shift;
            my ( $stmt, @bind ) = $sql->delete(
                'friends',
                +{
                    -or => [
                        +{ id => $id,        friend_id => $friend_id },
                        +{ id => $friend_id, friend_id => $id }
                    ],
                }
            );
            $dbh->do( $stmt, undef, @bind ) or croak( $dbh->errstr );
            $dbh->commit or croak( $dbh->errstr );
        },
    );
}

sub test_created_friends {
    my %specs = @_;
    my ( $input, $expects, $desc ) = @specs{qw/input expects desc/};

    subtest $desc => sub {
        lives_ok {
            create_friends( $conn, @$input{qw/id friend_id/} );
        }
        'create_friends() will be lives';

        $conn->run(
            fixup => sub {
                my $dbh = shift;
                my ( $stmt, @bind ) = $sql->select(
                    'friends',
                    ['COUNT(id)'],
                    +{
                        -or => [
                            +{
                                id        => $input->{id},
                                friend_id => $input->{friend_id}
                            },
                            +{
                                id        => $input->{friend_id},
                                friend_id => $input->{id}
                            },
                        ]
                    }
                );
                my ($ret) = $dbh->selectrow_array( $stmt, undef, @bind );
                is(
                    $ret, 2,
                    sprintf(
                        '%d is friend with %d',
                        $input->{id}, $input->{friend_id}
                    )
                );

                ( $stmt, @bind ) =
                  $sql->select( 'people', [qw/id friends/],
                    +{ id => +{ -in => [ keys %$expects ] } } );

                my $friends_map =
                  $dbh->selectall_hashref( $stmt, 'id', undef, @bind );

                for my $id ( keys %$expects ) {
                    is(
                        $friends_map->{$id}{friends},
                        $expects->{$id},
                        sprintf(
                            q|user %d's friends is %d|,
                            $id, $expects->{$id}
                        )
                    );
                }
            },
        );

        done_testing;
    };
}

test_created_friends(
    input => +{
        id        => 1,
        friend_id => 2,
    },
    expects => +{
        1 => 1,
        2 => 1,
    },
    desc => 'create_friends(1, 2)'
);

test_created_friends(
    input => +{
        id        => 1,
        friend_id => 3,
    },
    expects => +{
        1 => 2,
        2 => 1,
        3 => 1,
    },
    desc => 'create_friends(1, 3)'
);

test_created_friends(
    input => +{
        id        => 3,
        friend_id => 1,
    },
    expects => +{
        1 => 2,
        2 => 1,
        3 => 1,
    },
    desc => '3 had been friends with 1'
);


done_testing;

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# coding: utf-8-unix
# End:
#
# vim: expandtab shiftwidth=4:

まとめ

という訳で Test::mysqld と Test::Fixture::DBI を使うと快適にデータベースのテストが出来ますよ！それと procedure/trigger のテストなんかも出来るので是非使ってみて下さい。 そして Test::Fixture::DBI は PostgreSQL には対応してないので対応してやんよ！って人は是非 pull リクエスト送って下さい。

がレポジトリです。

おしまい

もし時間が大幅に余ってたら

OpenSocial Gadget のテストを QUnit でやるお話するかもしれない。