#!/usr/local/bin/perl -w
use DBI;
print "1..$tests\n";
print "ok 1\n";
BEGIN { $tests = 1 }
exit 0;
# ----------------------------------------------------------
# engn/perldb2/t/main.t, engn_perldb2, db2_v82fp9, 1.2 98/10/01 09:41:37
#
# Copyright (c) 1994, Tim Bunce
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
# This is just my DBI test script, it's not as clean as it could be :-)
BEGIN {
print "$0 @ARGV\n";
print q{DBI test application $Revision: 0.2 $}."\n";
$| = 1; # chop($cwd = `pwd`); unshift(@INC, ".");
}
use DBI;
use Getopt::Long;
use strict;
$main::opt_d = 1;
$main::opt_h = 0;
$main::opt_dbname = 'crgs';
GetOptions('d=i', 'h=i', 'dbname=s')
or die "Usage: $0 [-d n] [-h n] [drivername]\n";
my($driver) = $ARGV[0] || 'Oracle';
print "opt_d=$main::opt_d\n" if $main::opt_d;
print "opt_h=$main::opt_h\n" if $main::opt_h;
# Now ask for some information from the DBI Switch
my($switch) = DBI->internal;
$switch->debug($main::opt_h); # 2=detailed handle trace
print "Switch: $switch->{'Attribution'}, $switch->{'Version'}\n";
$switch->{'DebugDispatch'} = $main::opt_d; # 2=detailed trace of all dispatching
print "DebugDispatch: $switch->{'DebugDispatch'}\n";
print "Available Drivers: ",join(", ",DBI->available_drivers()),"\n";
my($dbh); # first, get connected using either of these methods:
if (0){
$dbh = DBI->connect($::opt_dbname, '', '', $driver);
}else{
my($drh) = DBI->install_driver($driver);
print "Driver installed as $drh\n";
$dbh = $drh->connect($::opt_dbname, 'system', 'manager');
}
die "Unable for connect to $::opt_dbname: $DBI::errstr"
unless $dbh;
$dbh->debug($main::opt_h);
eval { run_test($dbh); };
print "run_test($dbh) failed: '$@'\n";
print "$0 Done. (global destruction will follow)\n\n";
exit 0;
sub run_test{
my($dbh) = @_;
print "Connected as $dbh\n\n";
$dbh->commit;
my($cursor_a) = $dbh->prepare("select SYSDATE from DUAL");
die "Prepare failed ($DBI::err): $DBI::errstr\n" unless $cursor_a;
print "Prepared as $cursor_a\n";
# $cursor_a->debug(2);
my($cursor_b) = $dbh->prepare("select SYSDATE+1 from DUAL");
die "Prepare failed ($DBI::err): $DBI::errstr\n" unless $cursor_b;
print "Prepared as $cursor_b\n";
# $cursor_b->debug(2);
# Test object attributes
print "Number of fields: $cursor_a->{'NUM_OF_FIELDS'}\n";
print "Number of fields: $cursor_a->{'NUM_OF_FIELDS'}\n"; # now cached
die "Test not fully implemented yet";
print "Data type of first field: $cursor_a->{'DATA_TYPE'}->[0]\n";
print "Driver name: $cursor_a->{'Database'}->{'Driver'}->{'Name'}\n";
$cursor_a->execute('/usr');
$cursor_b->execute('/usr/spool');
print "Fetching data from both cursors:\n";
my(@row_a, @row_b);
while((@row_a = $cursor_a->fetchrow)
&& (@row_b = $cursor_b->fetchrow)){
print "@row_a, @row_b\n";
}
print "\nAutomatic method parameter usage check:\n";
eval { $dbh->commit('dummy') };
warn "$@\n";
print "Preparing new \$cursor_a to replace current \$cursor_a:\n";
print "(we enable debugging on current to watch it's destruction)\n";
$cursor_a->debug(2);
$cursor_a = $dbh->prepare("select mtime,name from ?");
$cursor_a->execute('../..');
print "Fetching one row from new \$cursor_a:\n";
print join(' ',$cursor_a->fetchrow),"\n";
$cursor_a->finish;
print "test done (scoped objects will be destroyed now)\n";
}
# end.