I have rewritten my test for DBD::CSV.
test.t
-----------------------------------------------------------------------
#!perl -T
use strict;
use warnings;
use Test::More tests => 33 + 1;
use Test::NoWarnings;
BEGIN {
require_ok('DBI');
}
my $dbh;
# connext
{
$dbh = DBI->connect(
'dbi:CSV:f_dir=.',
undef,
undef,
{
RaiseError => 1,
PrintError => 0,
AutoCommit => 1,
},
);
isa_ok($dbh, 'DBI::db', 'connect');
}
# create table
{
unlink 'test.csv';
$dbh->do(<<'EO_SQL');
create table test.csv (
msgid varchar,
msgstr varchar,
fuzzy integer,
c_format integer,
php_format integer
)
EO_SQL
$dbh->do(<<'EO_SQL', undef, q{}, 'header');
INSERT INTO test.csv (
msgid,
msgstr,
) VALUES (?, ?)
EO_SQL
$dbh->do(<<'EO_SQL', undef, 'id', 'str');
INSERT INTO test.csv (
msgid,
msgstr,
) VALUES (?, ?)
EO_SQL
}
{
my $sth_update = $dbh->prepare(<<'EO_SQL');
UPDATE test.csv
SET fuzzy=?
WHERE msgid=?
EO_SQL
isa_ok($sth_update, 'DBI::st', 'prepare update header');
my $sth_select = $dbh->prepare(<<'EO_SQL');
SELECT fuzzy
FROM test.csv
WHERE msgid=?
EO_SQL
isa_ok($sth_select, 'DBI::st', 'prepare select header');
my @data = (
{
test => 'header fuzzy=1',
set => 1,
get => [1],
},
{
test => 'header fuzzy=0',
set => 0,
get => [0],
},
);
for my $data (@data) {
my $result = $sth_update->execute($data->{set}, q{});
is($result, 1, "update: $data->{test}");
$result = $sth_select->execute(q{});
is($result, 1, "select: $data->{test}");
$result = $sth_select->fetchrow_arrayref();
is_deeply($result, $data->{get}, "fetch result: $data->{test}");
}
}
# change flags
{
my $sth_update = $dbh->prepare(<<'EO_SQL');
UPDATE test.csv
SET fuzzy=?, c_format=?, php_format=?
WHERE msgid=?
EO_SQL
isa_ok($sth_update, 'DBI::st');
my $sth_select = $dbh->prepare(<<'EO_SQL');
SELECT fuzzy, c_format, php_format
FROM test.csv
WHERE msgid=?
EO_SQL
isa_ok($sth_select, 'DBI::st');
my @data = (
{
test => 'fuzzy=1',
set => [1, 0, 0],
get => [
{
fuzzy => 1,
c_format => 0,
php_format => 0,
},
],
},
{
test => 'c-format=1',
set => [0, 1, 0],
get => [
{
fuzzy => 0,
c_format => 1,
php_format => 0,
},
],
},
{
test => 'php-format=1',
set => [0, 0, 1],
get => [
{
fuzzy => 0,
c_format => 0,
php_format => 1,
},
],
callback => sub { check_file(shift, 'php-format') },
},
{
test => 'c-format=-1',
set => [0, -1, 0],
get => [
{
fuzzy => 0,
c_format => -1,
php_format => 0,
},
],
callback => sub { check_file(shift, 'no-c-format') },
},
{
test => 'php-format=-1',
set => [0, 0, -1],
get => [
{
fuzzy => 0,
c_format => 0,
php_format => -1,
},
],
callback => sub { check_file(shift, 'no-php-format') },
},
{
test => 'all=1',
set => [(1) x 3],
get => [
{
fuzzy => 1,
c_format => 1,
php_format => 1,
},
],
callback => sub { check_file(shift, 'all') },
},
{
test => 'all=0',
set => [(0) x 3],
get => [
{
fuzzy => 0,
c_format => 0,
php_format => 0,
},
],
callback => sub { check_file(shift) },
},
);
for my $data (@data) {
my $result = $sth_update->execute(
@{ $data->{set} },
'id',
);
is($result, 1, "update: $data->{test}");
$result = $sth_select->execute('id');
is($result, 1, "select: $data->{test}");
$result = $sth_select->fetchall_arrayref({});
is_deeply($result, $data->{get}, "fetch result: $data->{test}");
}
}
-----------------------------------------------------------------------
result DBI 1.604
-----------------------------------------------------------------------
D:\>perl -T test.t
1..34
ok 1 - require DBI;
ok 2 - connect isa DBI::db
ok 3 - prepare update header isa DBI::st
ok 4 - prepare select header isa DBI::st
ok 5 - update: header fuzzy=1
ok 6 - select: header fuzzy=1
ok 7 - fetch result: header fuzzy=1
ok 8 - update: header fuzzy=0
ok 9 - select: header fuzzy=0
ok 10 - fetch result: header fuzzy=0
ok 11 - The object isa DBI::st
ok 12 - The object isa DBI::st
ok 13 - update: fuzzy=1
ok 14 - select: fuzzy=1
ok 15 - fetch result: fuzzy=1
ok 16 - update: c-format=1
ok 17 - select: c-format=1
ok 18 - fetch result: c-format=1
ok 19 - update: php-format=1
ok 20 - select: php-format=1
ok 21 - fetch result: php-format=1
ok 22 - update: c-format=-1
ok 23 - select: c-format=-1
ok 24 - fetch result: c-format=-1
ok 25 - update: php-format=-1
ok 26 - select: php-format=-1
ok 27 - fetch result: php-format=-1
ok 28 - update: all=1
ok 29 - select: all=1
ok 30 - fetch result: all=1
ok 31 - update: all=0
ok 32 - select: all=0
ok 33 - fetch result: all=0
ok 34 - no warnings
-----------------------------------------------------------------------
result DBI 1.608
-----------------------------------------------------------------------
D:\>perl -T test.t
1..34
ok 1 - require DBI;
ok 2 - connect isa DBI::db
ok 3 - prepare update header isa DBI::st
ok 4 - prepare select header isa DBI::st
ok 5 - update: header fuzzy=1
ok 6 - select: header fuzzy=1
ok 7 - fetch result: header fuzzy=1
DBD::CSV::st execute failed: You passed 2 parameters where 1 required
[for State
ment " UPDATE test.csv
SET fuzzy=?
WHERE msgid=?
"] at test.pl line 84.
ok 8 - no warnings
# Looks like you planned 34 tests but ran 8.
# Looks like your test exited with 255 just after 8.
-----------------------------------------------------------------------
RT for rt.cpan.org