#!../../perl -w

# $Id: dbitest,v 1.18 1994/10/21 18:19:32 timbo Exp $
#
# 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: 1.18 $}."\n";
	$| = 1; chop($cwd = `pwd`); unshift(@INC, ".", "$cwd/../../lib");
}

use DBI;

use Getopt::Long;
use strict;

$main::opt_d = 0;
$main::opt_h = 0;

GetOptions('d=i', 'h=i') or die "Usage: $0 [-d n] [-h n] [drivername]\n";

my($driver) = $ARGV[0] || 'ExampleP';
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 if $main::opt_d;
print "DebugDispatch: $switch->{'DebugDispatch'}\n";

print "Available Drivers: ",join(", ",DBI->available_drivers()),"\n";

print "Read DBI special variables:\n";
print "err:    ";	print "$DBI::err\n";
DBI::set_err($switch, "test err value");
print "err:    ";	print "$DBI::err\n";
print "errstr: ";	print "$DBI::errstr\n";
print "Attempt to modify DBI special variables:\n";
$DBI::rows = 1;
print "\n";


my($dbh);   # first, get connected using either of these methods:
if (0){
	$dbh = DBI->connect('', '', '', $driver);
}else{
	my($drh) = DBI->install_driver($driver);
	print "Driver installed as $drh\n";
	$dbh = $drh->connect('', '', '');
}
$dbh->debug($opt_h);

run_test($dbh);

print "$0 Done. (global destruction will follow)\n\n";
exit 0;


sub run_test{
    my($dbh) = @_;

    print "Connected as $dbh\n\n";

    $dbh->commit;

    print "Test error handling: prepare invalid query:\n";
    my($cursor_e) = $dbh->prepare("select unknown_field_name from ?");
    if ($cursor_e){
	print "Prepare returned a value. Error not detected!\n";
    } else {
	print "Prepare detected error. \$DBI::err: $DBI::err\n";
    }
exit;


    my($cursor_a) = $dbh->prepare("select mode,ino,name from ?");
    print "Prepared as $cursor_a\n";
    # $cursor_a->debug(2);

    my($cursor_b) = $dbh->prepare("select blocks,size,name from ?");
    print "Prepared as $cursor_b\n";
    # $cursor_b->debug(2);

    # Test object attributes

    print "Number of fields: $cursor_a->{'NUM_OF_FIELDS'}\n";
    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.
