use strict;
use warnings;
use Test::More;
use File::Spec;
use Test::Database;
my %handle = (
mysql1 => Test::Database::Handle->new(
dsn => 'dbi:mysql:database=mydb;host=localhost;port=1234',
username => 'user',
password => 's3k r3t',
),
mysql2 => Test::Database::Handle->new(
dsn => 'dbi:mysql:database=mydb;host=remotehost;port=5678',
username => 'otheruser',
),
sqlite => Test::Database::Handle->new( dsn => 'dbi:SQLite:db.sqlite', ),
);
delete $_->{driver} for values %handle;
# test description:
# 1st char is variable to look at: array (@) or scalar ($)
# 2nd char is expected result: list (@), single item ($) or number (1)
my @code;
my %tests = map {
my ( $fmt, $code ) = split / /, $_, 2;
push @code, $code;
( $code => $fmt )
} split /\n/, << 'CODE';
@@ @handles = Test::Database->handles(@requests);
$1 $handle = Test::Database->handles(@requests);
$$ $handle = ( Test::Database->handles(@requests) )[0];
$$ ($handle) = Test::Database->handles(@requests);
$$ $handle = Test::Database->handle(@requests);
@$ @handles = Test::Database->handle(@requests);
CODE
my @tests = (
# request, expected response
[ [], [ @handle{qw( mysql1 mysql2 sqlite )} ], '' ],
[ ['mysql'], [ @handle{qw( mysql1 mysql2 )} ], q{'mysql'} ],
[ ['sqlite'], [], q{'sqlite'} ],
[ ['SQLite'], [ $handle{sqlite} ], q{'SQLite'} ],
[ ['Oracle'], [], q{'Oracle'} ],
[ [ 'SQLite', 'mysql' ],
[ @handle{qw( mysql1 mysql2 sqlite )} ],
q{'SQLite', 'mysql'}
],
[ [ 'mysql', 'SQLite', 'mysql' ],
[ @handle{qw( mysql1 mysql2 sqlite )} ],
q{'mysql', 'SQLite', 'mysql'}
],
[ [ 'mysql', 'Oracle', 'SQLite' ],
[ @handle{qw( mysql1 mysql2 sqlite )} ],
q{'Oracle', 'mysql', 'SQLite'}
],
[ [ { dbd => 'mysql' } ], [ @handle{qw( mysql1 mysql2 )} ], q{'mysql'} ],
[ [ { driver => 'mysql' } ],
[ @handle{qw( mysql1 mysql2 )} ],
q{'mysql'}
],
);
# reset the internal structures and force loading our test config
Test::Database->clean_config();
my $config = File::Spec->catfile( 't', 'database.rc' );
Test::Database->load_config( $config );
plan tests => @tests * keys %tests;
for my $test (@tests) {
my ( $requests, $responses, $desc ) = @$test;
my %expected = (
'1' => [ scalar @$responses ],
'$' => [ $responses->[0] ],
'@' => $responses,
'0' => [],
);
# try out each piece of code
my @requests = @$requests;
for my $code (@code) {
my ( $handle, @handles );
my ( $got, $expected ) = split //, $tests{$code};
# special case
$expected = '0' if $tests{$code} eq '@$' && !@$responses;
# run the code
eval "$code; 1;" or do {
ok( 0, $code );
diag $@;
next;
};
( my $mesg = $code ) =~ s/\@requests/$desc/;
$got
= $got eq '$' ? [$handle]
: $got eq '@' ? \@handles
: die "Unknown variable symbol $got";
ref && delete $_->{driver} for @$got;
is_deeply( $got, $expected{$expected}, $mesg );
}
}