#!/usr/bin/perl use strict; use warnings; use Test::More tests => 18; 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"); exit 0;