#!/usr/bin/perl -w
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
=
""
;
$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() );
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"
);
cmp_ok(
$dbh
->selectrow_array(
"SELECT UPPER('b')"
),
'eq'
,
'B'
,
'COMPUTED COLUMNS IN SELECT LIST'
);
$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
);
}
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'
);
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'
;
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();