#!/usr/bin/perl -w
use strict;
use DBI;

my ($sid,$user,$passwd) = (':ZDB','TEST','TEST');

print STDERR <<'EOS';
sapdbtest (c) 2001 by Flemming Frandsen <dion@swamp.dk>
This is free software licensed under the GNU General Public License (GPL)
EOS


# My little helper function, call with:
# The DBI database handle, The SQL code and the parameters.
# It will then return the result of the execute (or $sth if it's a dataset).
sub sql {
    my $db = shift;
    my $code = shift;
    my @param = @_;

    chomp $code; # No good reason to have a tailing \n
    
    my $sth = $db->prepare_cached($code);
    if (!$sth) {
	print "Unable to prepare: ".$DBI::errstr."\nSQL: $code\n";
	return undef;
    }
    
    # Bind the parameters:
    for (my $i=0;$i<@param;$i++) {
	
	my $p = $param[$i];

	if (ref($p)) {
	    $sth->bind_param_inout($i+1,$p,100);
	} else {
	    $sth->bind_param($i+1,$p);
	}
    }

    my $res = $sth->execute;
    if (!$res) {
	my $par = join(',', map( defined($_)?$_:'undef', @param));
	print "Unable to execute: ".$DBI::errstr."\nSQL: $code\nPAR: $par\n";
	return undef;
    }

    if (ref($res) eq 'ARRAY') {
	return $res;
    } else {
	return $sth;
    }
}


print STDERR "Connecting (to $sid as $user/$passwd)...";
my $db = DBI->connect("dbi:ODBC:$sid", $user, $passwd,
		      { 
			  AutoCommit=>0,
			  LongReadLen=>10000,
		      }
		      );

unless ($db) {
    die "Failed to connect to the database $sid as user $user with password $passwd: ".$DBI::errstr;
}
print STDERR "Done.\n";


print STDERR "Creating stuff...";
sql($db,<<'EOQ') or die "Unable to create table a";
CREATE TABLE a (
  id INT NOT NULL,
  
  nullable_field INT,
  notnullable_field INT NOT NULL,
  default_field INT DEFAULT 42,
  string_field VARCHAR(40),
  
  PRIMARY KEY(id)
)
EOQ

sql($db,<<'EOQ') or die "Unable to create sequence";
CREATE SEQUENCE ids
INCREMENT BY 1
START WITH 1
EOQ

print STDERR "Done.\n";


print STDERR "Testing sequence and output parameters...";
for (my $i=1;$i<=30;$i++) {
    my $id=-1;
    sql($db,<<'EOQ',\$id) or die "Unable to fetch value from sequence";
SELECT ids.NEXTVAL INTO ? FROM dual
EOQ
    
    if ($id < $i)  {
	die "fetched id: $id is not the same as the expected id: $i";
    }

   print STDERR "$id,";
}
print STDERR "Done.\n";


print STDERR "Testing insert/select and input parameters...";
my $lastid = 424242;
sql($db,<<'EOQ', $lastid, undef, 37, "Hello world $lastid" ) or die "Unable to insert data with inputparameters";
INSERT INTO a (id, nullable_field, notnullable_field, string_field)
VALUES (?, ?, ?, ?)
EOQ

my $res = sql($db,<<'EOQ', $lastid ) or die "Unable to fetch data with input parameters";
SELECT id, nullable_field, notnullable_field, default_field, string_field
FROM a 
WHERE id = ?
EOQ

my ($id, $nullable_field, $notnullable_field, $default_field, $string_field) = $res->fetchrow_array or die "Unable to find the inserted row";
$res->finish;

if ($id != $lastid)           {die "fetched id ($id) is not the same as the inserted id ($lastid)"; }
if (defined $nullable_field)  {die "fetched nullable_field is not undef (aka null), it was $nullable_field"; }
if ($notnullable_field != 37) {die "fetched notnullable_field was not 37, it was $notnullable_field"; }
if ($default_field != 42)     {die "fetched default_field was not 42, it was: $default_field"; }
if ($string_field ne "Hello world $lastid") {die "fetched string_field was not correct, it was: $string_field"; }

print STDERR "Done.\n";

print STDERR "Testing invalid prepare...";
$db->prepare("select garbage from garbage") and die "invalid query could be prepared";
print STDERR "Done\n";

print STDERR "Testing ping...";
$db->ping or die "ping doesn't work";
print STDERR "Done\n";

print STDERR "Testing undef inout...";
my $hmm=undef;
sql($db,<<'EOQ',\$hmm) or die "Unable to fetch value from sequence, with a null inout parameter";
SELECT ids.NEXTVAL INTO ? FROM dual
EOQ
print STDERR "Done\n";

$db->rollback;
$db->disconnect;
print "All tests passed\n";