#!/usr/bin/perl -w
use strict;
BEGIN {
$| = 1;
eval 'use DBI 1.00';
if ($@ ne '')
{
print "1..0 # SKIP No DBI module\n";
print "DBI couldn't be loaded, aborting test\n";
print "Error returned from eval was:\n", $@;
exit;
}
print "1..31\n";
print "DBI loaded\n";
}
END { print "not ok 1\n" unless $::DBIloaded; }
### DBI->trace(2);
$::DBIloaded = 1;
print "ok 1\n";
my $dir = ( -d './t' ? 't' : '.' );
print "Connect to dbi:XBase:$dir\n";
my $dbh = DBI->connect("dbi:XBase:$dir", undef, undef, {'PrintError' => 1}) or do
{
print $DBI::errstr;
print "not ok 2\n";
exit;
};
print "ok 2\n";
my $command;
my $sth;
my ($result, $expected_result);
sub compare_result {
my ($result, $testnum) = @_;
my $expected_result = '';
while (<DATA>)
{ last if /^__END_DATA__$/; $expected_result .= $_; }
if (not $result =~ /\n$/) { $result .= "\n"; }
if (not $expected_result =~ /\n$/) { $expected_result .= "\n"; }
if ($result ne $expected_result)
{ print "Expected:\n${expected_result}Got:\n${result}not "; }
print "ok $testnum\n";
}
$command = "select ID, MSG from test";
print "Prepare command `$command'\n";
$sth = $dbh->prepare($command) or print $dbh->errstr(), 'not ';
print "ok 3\n";
print "Test the NAME attribute of the sth\n";
compare_result("@{$sth->{'NAME'}}", 4);
print "Execute the command\n";
$sth->execute() or print $sth->errstr(), 'not ';
print "ok 5\n";
print "Read the data and test them\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 6);
$command = "select ID cislo, ID + 1, ID - ? from test";
print "Prepare command `$command'\n";
$sth = $dbh->prepare($command) or print $dbh->errstr(), 'not ';
print "ok 7\n";
print "Test the NAME attribute of the sth\n";
compare_result("@{$sth->{'NAME'}}", 8);
print "Execute the command with value 5\n";
$sth->execute(5) or print $sth->errstr(), 'not ';
print "ok 9\n";
print "Read the data and test them\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 10);
$command = "select 1 jedna, id, ? parametr from test where id = ?";
print "Prepare command `$command'\n";
$sth = $dbh->prepare($command) or print $dbh->errstr(), 'not ';
print "ok 11\n";
print "Test the NAME attribute of the sth\n";
compare_result("@{$sth->{'NAME'}}", 12);
print "Execute the command with values 8, 3\n";
$sth->execute(8, 3) or print $sth->errstr(), 'not ';
print "ok 13\n";
print "Read the data and test them\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 14);
### $ENV{'SQL_DUMPER'} = 1;
$command = "select id, length(msg), msg txt from test where id < ?";
print "Prepare command `$command'\n";
$sth = $dbh->prepare($command) or print $dbh->errstr(), 'not ';
print "ok 15\n";
print "Test the NAME attribute of the sth\n";
compare_result("@{$sth->{'NAME'}}", 16);
print "Execute the command with value 4\n";
$sth->execute(4) or print $sth->errstr(), 'not ';
print "ok 17\n";
print "Read the data and test them\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 18);
print "Execute the command with value 16\n";
$sth->execute(16) or print $sth->errstr(), 'not ';
print "ok 19\n";
print "Read the data and test them (note that with bind params, it's string)\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 20);
$command = "select (id + 5) || msg str, msg || ' datum ' || dates from test";
print "Prepare command `$command'\n";
$sth = $dbh->prepare($command) or print $dbh->errstr(), 'not ';
print "ok 21\n";
print "Test the NAME attribute of the sth\n";
compare_result("@{$sth->{'NAME'}}", 22);
print "Execute the command\n";
$sth->execute() or print $sth->errstr(), 'not ';
print "ok 23\n";
print "Read the data and test them\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 24);
$command = "select concat(45, ' jezek', '-krtek') from test where id = 1";
print "Prepare command `$command'\n";
$sth = $dbh->prepare($command) or print $dbh->errstr(), 'not ';
print "ok 25\n";
print "Execute the command\n";
$sth->execute() or print $sth->errstr(), 'not ';
print "ok 26\n";
print "Read the data and test them\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 27);
$command = "select substr('jezek leze', 3, 7) cast,
substring(trim(' krtek '), 0, 3) from test where id = 1";
print "Prepare command `$command'\n";
$sth = $dbh->prepare($command) or print $dbh->errstr(), 'not ';
print "ok 28\n";
print "Test the NAME attribute of the sth\n";
compare_result("@{$sth->{'NAME'}}", 29);
print "Execute the command\n";
$sth->execute() or print $sth->errstr(), 'not ';
print "ok 30\n";
print "Read the data and test them\n";
$result = '';
while (my @data = $sth->fetchrow_array) { $result .= "@data\n"; }
compare_result($result, 31);
$sth->finish();
$dbh->disconnect();
1;
__DATA__
ID MSG
__END_DATA__
1 Record no 1
3 Message no 3
__END_DATA__
cislo ID+1 ID-?
__END_DATA__
1 2 -4
3 4 -2
__END_DATA__
jedna ID parametr
__END_DATA__
1 3 8
__END_DATA__
ID LENGTH(MSG) txt
__END_DATA__
1 11 Record no 1
3 12 Message no 3
__END_DATA__
1 11 Record no 1
__END_DATA__
str MSG||' DATUM '||DATES
__END_DATA__
6Record no 1 Record no 1 datum 19960813
8Message no 3 Message no 3 datum 19960102
__END_DATA__
45 jezek-krtek
__END_DATA__
cast SUBSTRING(TRIM(' KRTEK '),0,3)
__END_DATA__
zek lez krt
__END_DATA__