#!/usr/bin/perl -w
use strict;
use lib qw(t);
use TestLib qw(connect prove_reqs show_reqs test_dir default_recommended);
my ( $required, $recommended ) = prove_reqs( { default_recommended(), ( MLDBM => 0 ) } );
show_reqs( $required, $recommended );
my @test_dbds = ( 'SQL::Statement', grep { /^dbd:/i } keys %{$recommended} );
my $testdir = test_dir();
foreach my $test_dbd (@test_dbds)
{
my $dbh;
diag("Running tests for $test_dbd");
my $temp = "";
# XXX
# my $test_dbd_tbl = "${test_dbd}::Table";
# $test_dbd_tbl->can("fetch") or $temp = "$temp";
$test_dbd eq "DBD::File" and $temp = "TEMP";
$test_dbd eq "SQL::Statement" and $temp = "TEMP";
my %extra_args;
if ( $test_dbd eq "DBD::DBM" and $recommended->{MLDBM} )
{
$extra_args{dbm_mldbm} = "Storable";
}
$dbh = connect(
$test_dbd,
{
PrintError => 0,
RaiseError => 0,
f_dir => $testdir,
%extra_args,
}
);
my ( $sth, $str );
ok( $dbh->do(qq{ CREATE $temp TABLE Tmp (id INT,phrase VARCHAR(30)) }), 'CREATE Tmp' )
or diag( $dbh->errstr() );
ok( $dbh->do( qq{ INSERT INTO Tmp (id,phrase) VALUES (?,?) }, {}, 9, 'yyy' ),
'placeholder insert with named cols' )
or diag( $dbh->errstr() );
ok( $dbh->do( qq{ INSERT INTO Tmp VALUES(?,?) }, {}, 2, 'zzz' ),
'placeholder insert without named cols' )
or diag( $dbh->errstr() );
$dbh->do( qq{ INSERT INTO Tmp (id,phrase) VALUES (?,?) }, {}, 3, 'baz' ) or diag( $dbh->errstr() );
ok( $dbh->do( qq{ DELETE FROM Tmp WHERE id=? or phrase=? }, {}, 3, 'baz' ),
'placeholder delete' );
ok( $dbh->do( qq{ UPDATE Tmp SET phrase=? WHERE id=?}, {}, 'bar', 2 ), 'placeholder update' ) or diag( $dbh->errstr() );
ok( $dbh->do( qq{ UPDATE Tmp SET phrase=?,id=? WHERE id=? and phrase=?},
{}, 'foo', 1, 9, 'yyy' ),
'placeholder update' ) or diag( $dbh->errstr() );
ok( $dbh->do( qq{INSERT INTO Tmp VALUES (3, 'baz'), (4, 'fob'),
(5, 'zab')} ),
'multiline insert' ) or diag( $dbh->errstr() );
$sth = $dbh->prepare('SELECT id,phrase FROM Tmp ORDER BY id');
ok($sth, "prepare 'SELECT id,phrase FROM Tmp ORDER BY id'") or diag( $dbh->errstr() );
$sth->execute() or diag( $dbh->errstr() );
$str = '';
while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
cmp_ok( $str, 'eq', '1 foo^2 bar^3 baz^4 fob^5 zab^', 'verify table contents' );
ok( $dbh->do(qq{ DROP TABLE IF EXISTS Tmp }), 'DROP TABLE' ) or diag( $dbh->errstr() );
########################################
# CREATE, INSERT, UPDATE, DELETE, SELECT
########################################
ok( $dbh->do($_), $dbh->command() ) for split /\n/, <<"";
CREATE $temp TABLE phrase (id INT,phrase VARCHAR(30))
INSERT INTO phrase VALUES(1,UPPER(TRIM(' foo ')))
INSERT INTO phrase VALUES(2,'baz')
INSERT INTO phrase VALUES(3,'qux')
UPDATE phrase SET phrase=UPPER(TRIM(LEADING 'z' FROM 'zbar')) WHERE id=3
DELETE FROM phrase WHERE id = 2
$sth = $dbh->prepare("SELECT UPPER('a') AS A,phrase FROM phrase");
ok($sth, "prepare 'SELECT UPPER('a') AS A,phrase FROM phrase'") or diag( $dbh->errstr() );
$sth->execute or diag( $dbh->errstr() );
$str = '';
while ( my $r = $sth->fetch_row() ) { $str .= "@$r^"; }
ok( $str eq 'A FOO^A BAR^', 'SELECT' );
cmp_ok( scalar $dbh->selectrow_array("SELECT COUNT(*) FROM phrase"), '==', 2, 'COUNT *' );
ok( $dbh->do("DROP TABLE phrase"), "DROP $temp TABLE" );
#################################
# COMPUTED COLUMNS IN SELECT LIST
#################################
cmp_ok( $dbh->selectrow_array("SELECT UPPER('b')"),
'eq', 'B', 'COMPUTED COLUMNS IN SELECT LIST' );
###########################
# CREATE function in script
###########################
$dbh->do("CREATE FUNCTION froog");
sub froog { 99 }
ok( '99' eq $dbh->selectrow_array("SELECT froog()"), 'CREATE FUNCTION from script' );
for my $sql (
split /\n/, <<""
CREATE $temp TABLE a (b INT, c CHAR)
INSERT INTO a VALUES(1,'abc')
INSERT INTO a VALUES(2,'efg')
INSERT INTO a VALUES(3,'hij')
INSERT INTO a VALUES(4,'klm')
INSERT INTO a VALUES(5,'nmo')
INSERT INTO a VALUES(6,'pqr')
INSERT INTO a VALUES(7,'stu')
INSERT INTO a VALUES(8,'vwx')
INSERT INTO a VALUES(9,'yz')
SELECT b,c FROM a WHERE c LIKE '%b%' ORDER BY c DESC"
)
{
note("<$sql>");
$sth = $dbh->prepare( $sql );
ok( $sth->execute(), '$stmt->execute "' . $sql . '" (' . $sth->command() . ')' );
next unless ( $sth->command() eq 'SELECT' );
cmp_ok( ref( $sth->where_hash ), 'eq', 'HASH', '$stmt->where_hash' );
cmp_ok( $sth->columns(0)->name(), 'eq', 'b', '$stmt->columns' );
cmp_ok( join( '', @{$sth->col_names()} ), 'eq', 'bc', '$stmt->column_names' );
cmp_ok( $sth->order(0)->{direction}, 'eq', 'DESC', '$stmt->order' );
while ( my $row = $sth->fetch_row() )
{
cmp_ok( $row->[0], '==', 1, '$stmt->fetch' );
}
}
my %gen_inbtw = (
q{SELECT b,c FROM a WHERE b IN (2,3,5,7)} => '2^efg^3^hij^5^nmo^7^stu',
q{SELECT b,c FROM a WHERE b NOT IN (2,3,5,7)} => '1^abc^4^klm^6^pqr^8^vwx^9^yz',
q{SELECT b,c FROM a WHERE NOT b IN (2,3,5,7)} => '1^abc^4^klm^6^pqr^8^vwx^9^yz',
q{SELECT b,c FROM a WHERE b BETWEEN (5,7)} => '5^nmo^6^pqr^7^stu',
q{SELECT b,c FROM a WHERE b NOT BETWEEN (5,7)} => '1^abc^2^efg^3^hij^4^klm^8^vwx^9^yz',
q{SELECT b,c FROM a WHERE NOT b BETWEEN (5,7)} => '1^abc^2^efg^3^hij^4^klm^8^vwx^9^yz',
q{SELECT b,c FROM a WHERE c IN ('abc','klm','pqr','vwx','yz')} => '1^abc^4^klm^6^pqr^8^vwx^9^yz',
q{SELECT b,c FROM a WHERE c NOT IN ('abc','klm','pqr','vwx','yz')} => '2^efg^3^hij^5^nmo^7^stu',
q{SELECT b,c FROM a WHERE NOT c IN ('abc','klm','pqr','vwx','yz')} => '2^efg^3^hij^5^nmo^7^stu',
q{SELECT b,c FROM a WHERE c BETWEEN ('abc','nmo')} => '1^abc^2^efg^3^hij^4^klm^5^nmo',
q{SELECT b,c FROM a WHERE c NOT BETWEEN ('abc','nmo')} => '6^pqr^7^stu^8^vwx^9^yz',
q{SELECT b,c FROM a WHERE NOT c BETWEEN ('abc','nmo')} => '6^pqr^7^stu^8^vwx^9^yz',
);
while ( my ( $sql, $result ) = each(%gen_inbtw) )
{
my $sth = $dbh->prepare($sql);
ok( $sth->execute(), '$stmt->execute "' . $sql . '" (' . $sth->command . ')' );
my @res;
while ( my $row = $sth->fetch_row() )
{
push( @res, @{$row} );
}
is( $result, join( '^', @res ), $sql );
}
###########################
# CREATE function in module
###########################
BEGIN
{
eval 'package Foo; sub foo { 88 } sub bar { return $_[2] * 2; } 1;';
}
$dbh->do(qq{CREATE FUNCTION foofoo NAME "Foo::foo"});
$dbh->do(qq{CREATE FUNCTION foobar NAME "Foo::bar"});
ok( 88 == $dbh->selectrow_array("SELECT foofoo()"), 'CREATE FUNCTION from module' );
ok( 42 == $dbh->selectrow_array("SELECT foobar(21)"), 'CREATE FUNCTION from module with argument' );
################
# LOAD functions
################
SKIP: {
-e 'Bar.pm' and unlink 'Bar.pm';
my $fh;
open( $fh, '>Bar.pm' ) or skip(1, $!);
print $fh "package Bar; sub SQL_FUNCTION_BAR{77};1;";
close $fh;
$dbh->do("LOAD Bar");
ok( 77 == $dbh->selectrow_array("SELECT bar()"), 'LOAD FUNCTIONS' );
}
-e 'Bar.pm' and unlink 'Bar.pm';
#my $foo=0;
#sub test2 {$foo = 6;}
#open(O,'>','tmpss.sql') or die $!;
#print O "SELECT test2";
#close O;
#$dbh->do("CREATE FUNCTION test2");
#ok($dbh->do(qq{CALL RUN('tmpss.sql')}),'run');
#ok(6==$foo,'call run');
#unlink 'tmpss.sql' if -e 'tmpss.sql';
SKIP:
{
if ( $test_dbd eq "DBD::DBM" and !$recommended->{MLDBM} )
{
skip( "DBD::DBM Update test won't run without MLDBM", 3 );
}
my $pauli = [
[ 1, 'H', 19 ],
[ 2, 'H', 21 ],
[ 3, 'KK', 1 ],
[ 4, 'KK', 2 ],
[ 5, 'KK', 13 ],
[ 6, 'MMM', 25 ],
];
ok( $dbh->do(qq{CREATE $temp TABLE pauli (id INT, column1 VARCHAR, column2 INTEGER)}),
'CREATE pauli test table' )
or diag( $dbh->errstr() );
$sth = $dbh->prepare("INSERT INTO pauli VALUES (?, ?, ?)");
foreach my $line ( @{$pauli} )
{
$sth->execute( @{$line} );
}
$sth = $dbh->prepare("UPDATE pauli SET column1 = ? WHERE column1 = ?");
my $cnt = $sth->execute( "XXXX", "KK" );
cmp_ok( $cnt, '==', 3, 'UPDATE with placeholders' );
$sth->finish();
$sth = $dbh->prepare("SELECT column1, COUNT(column1) FROM pauli GROUP BY column1");
$sth->execute();
my $hres = $sth->fetchall_hashref('column1');
cmp_ok( $hres->{XXXX}->{'COUNT'}, '==', 3, 'UPDATE with placeholder updates correct' );
}
}
done_testing();