#!/usr/bin/perl -w # -*- mode: perl; coding: utf-8 -*- use strict; use warnings FATAL => qw(all); use Test::More; use Test::Differences; use FindBin; use lib "$FindBin::Bin/.."; foreach my $req (qw(DBD::SQLite SQL::Abstract)) { unless (eval qq{require $req}) { plan skip_all => "$req is not installed."; exit; } } plan qw(no_plan); use YATT::Util::Finalizer; ok chdir($FindBin::Bin), "chdir to testdir"; my $CLS = 'YATT::DBSchema'; my $MEMDB = ':memory:'; require_ok($CLS); sub raises (&@) { my ($test, $errPat, $title) = @_; eval {$test->()}; Test::More::like $@, $errPat, $title; } sub trim ($) {my $text = shift; $text =~ s/\n\Z//; $text} sub cat { my ($fn) = @_; open my $fh, '<', $fn or die "$fn: $!"; chomp(my @all = <$fh>); wantarray ? @all : \@all; } # use 抜きの、素の YATT::DBSchema->create を試す。 my @test1 = ($ENV{DEBUG} ? (-verbose) : () , -auto_create , [foo => [] , [foo_id => 'integer' , -primary_key, -auto_increment] , [foo => 'varchar(80)', -indexed] , [bar_id => [bar => [] , [bar_id => 'integer' , -primary_key, -auto_increment] , [bar => 'varchar(80)', -unique]]] , [baz => 'varchar(80)']]); { my $schema = $CLS->define(@test1); eq_or_diff scalar $schema->sql_create(dbtype => 'sqlite') , trim <sql_create(dbtype => 'mysql') , trim <sql(qw(insert foo)), <sql(qw(select foo)), trim <sql(qw(update bar bar)) , trim <connect_to(foo => 'bar')} qr{^YATT::DBSchema: Unknown dbtype: foo} , "Unknown dbtype"; } # t/test-mysql.pass should contain # * dbname=$mysql_dbname # * $user # * $pass SKIP: foreach my $dbspec ([undef, sqlite => $MEMDB, 'w'] , ["test-mysql.dsn", dbi => 'dbi:mysql']) { my ($passfn, @spec) = @$dbspec; if (defined $passfn) { skip "DSN not configured: $passfn", 8 unless -r $passfn; my ($dbiarg, $user, $pass) = my @lines = cat($passfn); ok @lines >= 3, "DSN has enough lines"; $spec[1] .= ":$dbiarg"; @spec[2,3] = ($user, $pass); } my $schema = $CLS->define(@test1); $schema->connect_to(@spec); if (defined $passfn) { $schema->drop; $schema->create; } my $ins = $schema->to_insert('foo'); $ins->('FOOx', 'AAA', 'BAZ'); my $test_foo = sub { $schema->dbh->selectall_arrayref(<() , [['FOOx', 'AAA', 'BAZ']], "[@spec[0,1]]. 1 row inserted."; $ins->('fooy', 'AAA', 'baz'); $ins->('Fooz', 'bbb', 'baz'); is_deeply $test_foo->() , [['FOOx', 'AAA', 'BAZ'] , ['fooy', 'AAA', 'baz'] , ['Fooz', 'bbb', 'baz']], "[@spec[0,1]]. and 2 rows inserted."; is_deeply $schema->to_fetch (foo => [qw(foo bar baz)] , where => {bar => 'bbb'})->fetchall_arrayref , [['Fooz', 'bbb', 'baz']] , "[@spec[0,1]]. to_fetch->fetchall_arrayref where {bar => 'bbb'}"; is_deeply $schema->to_select (foo => [qw(foo bar baz)] , where => {bar => 'bbb'})->() , [['Fooz', 'bbb', 'baz']] , "[@spec[0,1]]. to_select()->() where {bar => 'bbb'}"; is_deeply $schema->select (foo => [qw(foo bar baz)] , hashref => 1, limit => 1, order_by => 'foo_id desc') , {foo => 'Fooz', bar => 'bbb', baz => 'baz'} , "[@spec[0,1]]. select hashref {}"; is_deeply $schema->select (foo => [qw(foo bar baz)] , arrayref => 1, limit => 1, order_by => 'foo_id desc') , ['Fooz', 'bbb', 'baz'] , "[@spec[0,1]]. select arrayref []"; { my $id = $schema->select(foo => foo_id => where => {foo => 'Fooz'})->[0]; $schema->to_update(foo => 'baz')->("bazzzz", $id); is_deeply $schema->select(foo => 'baz' , where => {foo => 'Fooz'})->[0], "bazzzz" , "[@spec[0,1]]. update foo baz=bazzzz"; } $schema->drop; $schema->dbh->commit; } # import and run { { package dbsch_test; $CLS->import(-as_base , connection_spec => [sqlite => ':memory:', 'w'] , [foo => [] , [foo => 'varchar', -indexed] , [bar_id => [bar => [] , [bar_id => 'integer', -primary_key] , [bar => 'varchar', -unique]]] , [baz => 'varchar']]); } raises {dbsch_test->run} qr{^Usage: dbsch.t method args..}, "run help"; eq_or_diff capture {dbsch_test->run(select => 'foo')}, <run(sql => select => 'foo') }, <ymd_hms(0 - $tz), '1970-01-01 00:00:00', 'ymd_hms localtime'; is $CLS->ymd_hms(0, 1), '1970-01-01 00:00:00', 'ymd_hms utc'; }