The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

use DBI qw(:sql_types);

my $dbname = "DBI:Unify:$ENV{DBPATH}";

my $dbh;
ok ($dbh = DBI->connect ($dbname, undef, "", {
	RaiseError    => 1,
	PrintError    => 1,
	AutoCommit    => 0,
	ChopBlanks    => 1,
	uni_verbose   => 0,
	uni_scanlevel => 7,
	}), "connect with attributes");

unless ($dbh) {
    BAIL_OUT ("Unable to connect to Unify ($DBI::errstr)\n");
    exit 0;
    }

{   my $sts;
    ok ($sts = $dbh->prepare (q;
	select COLCODE
	from   SYS.COLTYPE
	where  COLTYPE = 'FLOAT';
	), "prepare equal");
    ok ($sts->execute,	"execute equal");
    my ($colcode) = $sts->fetchrow_array;
    is ($colcode, 8,	"fetch equal");
    ok ($sts->finish,	"finish equal");
    }

#$dbh->{uni_verbose} = 999;
{   my $sts;
    ok ($sts = $dbh->prepare (q;
	select COLCODE
	from   SYS.COLTYPE
	where  COLTYPE like 'AMOU%';
	), "prepare like");
    ok ($sts->execute,	"execute like");
    my ($colcode) = $sts->fetchrow_array;
    is ($colcode, 4,	"fetch like");
    ok ($sts->finish,	"finish like");
    }

{   my $sts;
    ok ($sts = $dbh->prepare (q;
	select COLCODE
	from   SYS.COLTYPE
	where  COLTYPE reglike '^DOUB.*';
	), "prepare reglike");
    ok ($sts->execute,	"execute reglike");
    my ($colcode) = $sts->fetchrow_array;
    is ($colcode, 15,	"fetch reglike");
    ok ($sts->finish,	"finish reglike");
    }

SKIP: {
    my @sqlv = `SQL -version`;
    my ($rev) = ("@sqlv" =~ m/Revision:\s+(\d[.\d]*)/);
    $rev < 8.2 and skip "SHLIKE will dump core", 4;

    my $sts;
    ok ($sts = $dbh->prepare (q;
	select COLCODE
	from   SYS.COLTYPE
	where  COLTYPE shlike 'CHAR*';
	), "prepare shlike");
    ok ($sts->execute,	"execute shlike");
    my ($colcode) = $sts->fetchrow_array;
    is ($colcode, 5,	"fetch shlike");
    ok ($sts->finish,	"finish shlike");
    }

ok ($dbh->disconnect,	"disconnect");

done_testing;