From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!perl -w
# $Id: testdestruction.pl 11680 2008-08-28 08:23:27Z mjevans $
use strict;
use DBI qw(:sql_types);
my $usage = "perl dbtest.pl [-b]. -b binds parameters explicitly.\n";
my @data = (
["2001-01-01 01:01:01.111", "a" x 12], # "aaaaaaaaaaaa"
["2002-02-02 02:02:02.222", "b" x 114],
["2003-03-03 03:03:03.333", "c" x 251],
["2004-04-04 04:04:04.444", "d" x 282],
["2005-05-05 05:05:05.555", "e" x 131]
);
# Get command line options:
my %args;
getopts ("b", \%args) or die $usage;
my $bind = $args{"b"};
# Connect to the database and create the table:
my $dbh=DBI->connect() or die "Can't connect";
$dbh->{RaiseError} = 1;
$dbh->{LongReadLen} = 800;
eval {
$dbh->do("DROP TABLE foo");
};
my @types = (SQL_TYPE_TIMESTAMP, SQL_TIMESTAMP);
my $type;
my @row;
foreach $type (@types) {
my $sth = $dbh->func($type, "GetTypeInfo");
if ($sth) {
@row = $sth->fetchrow();
$sth->finish();
last if @row;
} else {
# warn "Unable to get type for type $type\n";
}
}
die "Unable to find a suitable test type for date field\n"
unless @row;
my $dbname = $dbh->get_info(17); # sql_dbms_name
my $datetype = $row[0];
print "Date type = $datetype\n";
$dbh->do("CREATE TABLE foo (i INTEGER, time $datetype, str VARCHAR(4000))");
# Insert records into the database:
my $sth1 = $dbh->prepare("INSERT INTO FOO (i,time,str) values (?,?,?)");
for (my $i=0; $i<@data; $i++) {
my ($time,$str) = @{$data[$i]};
print "Inserting: $i, $time, string length ".length($str)."\n";
if ($bind) {
$sth1->bind_param (1, $i, SQL_INTEGER);
$sth1->bind_param (2, $time, SQL_TIMESTAMP);
$sth1->bind_param (3, $str, SQL_LONGVARCHAR);
$sth1->execute or die ($DBI::errstr);
} else {
$sth1->execute ($i, $time, $str) or die ($DBI::errstr);
}
}
print "\n";
# Retrieve records from the database, and see if they match original data:
my $sth2 = $dbh->prepare("SELECT i,time,str FROM foo");
$sth2->execute or die ($DBI::errstr);
while (my ($i,$time,$str) = $sth2->fetchrow_array()) {
print "Retrieving: $i, $time, string length ".length($str)."\t";
print "!time " if ($time ne $data[$i][0]);
print "!string" if ($str ne $data[$i][1]);
print "\n";
}
$dbh->disconnect;
$dbh = undef;
$sth2 = undef;