日向夏特殊応援部隊

俺様向けメモ

初めての Q4M, Test::mysqld を使ったテストの準備


id:kazuhooku さんの指摘 *1 を受けて transaction してた所を修正。AutoCommit をとりあえず 1 にしておきました。

#!/usr/bin/perl

use strict;
use warnings;

use DBI;
use Perl6::Say;
use SQL::Abstract;
use SQL::Abstract::Plugin::InsertMulti;
use Test::More;
use Test::mysqld;

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

my $dbh = DBI->connect('dbi:mysql:dbname=test;mysql_socket=' . $m->base_dir . '/tmp/mysql.sock', 'root', '', +{ AutoCommit => 1, RaiseError => 1, });

ok($dbh);
isa_ok($dbh, 'DBI::db');

my @setup_queries = (
    q|INSTALL PLUGIN queue SONAME 'libqueue_engine.so'|,
    q|CREATE FUNCTION queue_wait RETURNS INT SONAME 'libqueue_engine.so'|,
    q|CREATE FUNCTION queue_end RETURNS INT SONAME 'libqueue_engine.so'|,
    q|CREATE FUNCTION queue_abort RETURNS INT SONAME 'libqueue_engine.so'|,
    q|CREATE FUNCTION queue_rowid RETURNS INT SONAME 'libqueue_engine.so'|,
    q|CREATE FUNCTION queue_set_srcid RETURNS INT SONAME 'libqueue_engine.so'|,
    q|CREATE TABLE qt (id int unsigned not null, msg text not null) engine=queue|,
);

eval {
    for (@setup_queries) {
        $dbh->do($_);
        die $dbh->errstr if ($dbh->err);
    }
};
if ($@) {
    warn $@;
    exit;
}

my @queue = ( [1, 'a'], [2, 'b'], [3, 'c'], );

eval {
    my $sql = SQL::Abstract->new;
    my ($stmt, @bind) = $sql->insert_multi('qt', [qw/id msg/], [ @queue ]);
    $dbh->do($stmt, undef, @bind);
};
if ($@) {
    warn $@;
    exit;
}

is_deeply($dbh->selectall_arrayref('select id, msg from qt'), \@queue);

$dbh->selectrow_arrayref('select queue_wait(?)', undef, 'qt');
note(explain($dbh->selectall_arrayref('select id, msg from qt')));

$dbh->selectrow_arrayref('select queue_end(?)', undef, 'qt');
note(explain($dbh->selectall_arrayref('select id, msg from qt')));

done_testing;

とりあえずこんな感じでどうか。