DBD-IngresII
view release on metacpan or search on metacpan
Bazley <Sebastian.BAZLEY@sema.co.uk>
Added RaiseError=>1 to the connect in t/dbi.t as per current
recomendation.
Changed the error return value of execute to 0 (not 0E0 which is the OK
with 0 rows), not -1, or -2 as it was. Wonder why though?
v0.24 1999.10.29
The "OF column..." part of the "FOR UPDATE" clause is optional.
Clarified the pod (or tried to at least).
This changes the behaviour of the updateable cursor patch added by
Dirk Koopman <djk@tobit.co.uk> in version 0.19_1. I hope nothing is
seriously broken by this change.
It does seem the best to let cursors be readonly by default and
explicitly change that if you want to update. The update of a cursor
without a "FOR UPDATE OF..." clause is not documented and could
go away at any time.
v0.23 1999.10.28
Now tries to discover whether a select-cursor should be opened READONLY
or not.
A select is opened READONLY unless there is a FOR UPDATE clause in the
select statement. This is done by a regexp in Ingres.pm, which might in
some cases (I just can't imagine which :-) could possibly give a false
positive - which will cause the select to take exclusive locks.
To allow the user to override the automatic readonly discovery is it
possible to write:
$sth = $dbh->prepare("Select....", {ing_readonly => $value});
v0.22 1999.10.26
Do please report any problem to me <ht@datani.dk>.
- Don't export $sql_dbh etc as default. (Ingperl.pm)
Warning:
This may break code that uses one or more of:
$sql_drh $sql_dbh $sql_sth $sql_debug $sql_rowcount
Change:
use Ingperl;
to:
use Ingperl( qw[ $sql_dbh $sql_sth ] );
- Added support for updateable cursors (experimental), Thanks to
Dirk Koopman <djk@tobit.co.uk>.
- Upgrade to support DBI 1.00 (experimental):
. re-prepare statement, that have gone out of scope (eq. after a
commit/rollback etc). Just first bash at it :-(, ie. for now just
keep tabs on whether the statement is invalidated by commit.
. add the new meta-data fields (TYPE, SCALE, PRECISION)
Ingres doesn't return the SCALE information so that is undef untill
further notice!
. first bash at type_info_all
. added $dbh->table_info (so $dbh->tables also works thanks to DBI)
V0.05_01 1997.04.16
Check on II_SYSTEM moved to connect (was at compile-time).
Improved library dectection for OpenIngres without installed ABF
component.
Improved Ingperl emulation (Ronald B. Irvin <rbirvin@usgs.gov>):
- &sql_fetch into scalar now returns first column of output
and warns if $sql_sth->{Warn} is true.
- Warnings from &sql_close without open cursor are now only
output if requested (uses $sql_sth->{Warn}).
- &sql_eval_col1 fixed.
Now known to work on DG-UX (Ronald B. Irvin <rbirvin@usgs.gov>).
Fetch(row) truncates trailing blanks from text-columns. This feature
can be disabled by setting $sth->{CompatMode} true. I was tired of
writing C<VARCHAR(column)> or C<$col=~S/\+$//;> all over the place!
WARNING: this may change old (DBD) code!!!
Ingperl sets CompatMode so Ingperl scripts are not affected.
and Tim Bunce <Tim.Bunce@ig.co.uk>)
Added support for DBI 0.77
V0.04 1997.01.17
The function DBD::Ingres::st:fetch has now been reinstated
(thanks to Tim Bunce <Tim.Bunce@ig.co.uk> who showed the way to
let case insentive linker handle case sensitivity)
V0.03 1997.01.09
Restriction on number of simultaniously open cursors removed
- inspiration from Dirk Kraemer (kraemer@rz.uni-kiel.de)
Multiple database connects possible
Must reuse statement numbers as the number of different
statement names between commits is limited by the available
parser memory. You get error:
E_PS0F02_MEMORY_FULL
There is no more available memory. Try again later.
when this happens.
IngresII.pm view on Meta::CPAN
=back
Due to their size (and hence the impracticality of copying them inside
the DBD driver), variables bound as blob types are always evaluated at
execute time rather than bind time. (Similar to bind_param_inout, except
you don't pass them as references.)
=head2 ing_readonly
Normally cursors are declared C<READONLY> to increase speed. READONLY
cursors don't create exclusive locks for all the rows selected; this is
the default.
If you need to update a row then you will need to ensure that either
=over 4
=item *
the C<select> statement contains an C<for update of> clause, or
IngresII.pm view on Meta::CPAN
$sth = $dbh->prepare("select .... for direct update of ..")
while
$sth = $dbh->prepare("select .... for direct update of ..",
{ ing_readonly => 1} );
will be opened C<FOR READONLY>.
When you wish to actually do the update, where you would normally put the
cursor name, you put:
$sth->{CursorName}
instead, for example:
$sth = $dbh->prepare("select a,b,c from t for update of b");
$sth->execute;
$row = $sth->fetchrow_arrayref;
$dbh->do("update t set b='1' where current of $sth->{CursorName}");
Later you can reexecute the statement without the update-possibility by doing:
$sth->{ing_readonly} = 1;
$sth->execute;
and so on. B<Note> that an C<update> will now cause an SQL error.
In fact the "FOR UPDATE" seems to be optional, i.e., you can update
cursors even if their SELECT statements do not contain a C<for update>
part.
If you wish to update such a cursor you B<must> include the C<ing_readonly>
attribute.
B<NOTE> DBD::IngresII version later than 0.19_1 have opened all cursors for
update. This change breaks that behaviour. Sorry if this breaks your code.
=head2 ing_rollback
The DBI docs state that 'Changing C<AutoCommit> from off to on will
trigger a C<commit>'.
Setting ing_rollback to B<on> will change that to 'Changing C<AutoCommit>
from off to on will trigger a C<rollback>'.
IngresII.pm view on Meta::CPAN
=head2 state
$h->state (undef)
SQLSTATE is not implemented.
=head2 disconnect_all
Not implemented
=head2 commit and rollback invalidate open cursors
DBD::IngresII should warn when a commit or rollback is isssued on a $dbh
with open cursors.
Possibly a commit/rollback should also undef the $sth's. (This should
probably be done in the DBI-layer as other drivers will have the same
problems).
After a commit or rollback the cursors are all ->finish'ed, i.e., they
are closed and the DBI/DBD will warn if an attempt is made to fetch
from them.
A future version of DBD::IngresII wil possibly re-prepare the statement.
This is needed for
=head2 Cached statements
A new feature in DBI that is not implemented in DBD::IngresII.
int
dbd_db_commit(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
dTHR;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_db_commit\n");
/* Check for commit() being called whilst refs to cursors */
/* still exists. This needs some more thought. */
if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty)
{
warn("DBD::Ingres::commit(%s) invalidates %d active cursor(s)",
SvPV(dbh,PL_na), (int)DBIc_ACTIVE_KIDS(imp_dbh));
}
set_session(dbh);
++ imp_dbh->trans_no;
EXEC SQL COMMIT;
return sql_check(dbh);
}
int
dbd_db_rollback(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
dTHR;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_db_rollback\n");
/* Check for commit() being called whilst refs to cursors */
/* still exists. This needs some more thought. */
if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty)
{
warn("DBD::Ingres::rollback(%s) invalidates %d active cursor(s)",
SvPV(dbh,PL_na), (int)DBIc_ACTIVE_KIDS(imp_dbh));
}
set_session(dbh);
++ imp_dbh->trans_no;
EXEC SQL ROLLBACK;
return sql_check(dbh);
}
SV*
EXEC SQL EXECUTE :name USING DESCRIPTOR &imp_sth->ph_sqlda;
}
else {
EXEC SQL EXECUTE :name;
}
return sql_check(sth) ? sqlca.sqlerrd[2] : -2;
}
else
{
int is_readonly;
/* select statement: open a cursor */
EXEC SQL DECLARE :name CURSOR FOR :name;
/* 0.23 open readonly unless an "FOR UPDATE"- clause is found in */
/* select statement. This is done in Ingres.pm in prepare, and */
/* is stored in the private variable $sth->{ing_readonly}. */
{
SV **svp;
if ( (svp = hv_fetch((HV*)SvRV(sth), "ing_readonly", 12, 0)) != NULL
&& SvTRUE(*svp))
{
is_readonly = 1;
}
else
is_readonly = 0;
}
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,
"DBD::Ingres::dbd_st_execute - cursor %s - param=%d %sreadonly\n",
name, imp_sth->ph_sqlda.sqld, is_readonly ? "" : "NOT ");
if (is_readonly)
if (imp_sth->ph_sqlda.sqld > 0)
{
EXEC SQL OPEN :name FOR READONLY
USING DESCRIPTOR &imp_sth->ph_sqlda;
}
else
EXEC SQL OPEN :name FOR READONLY;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_st_fetch(%s)\n", imp_sth->name);
/* needs to check for re-prepare (after commit etc.) */
if (imp_sth->trans_no != imp_dbh->trans_no)
croak("DBD::Ingres: Attempt to fetch from statement after commit");
if (!DBIc_ACTIVE(imp_sth))
{
error(sth, -7, "fetch without open cursor", 0);
return Nullav;
}
set_session(DBIc_PARENT_H(imp_sth));
sqlda = &imp_sth->sqlda;
if (dbis->debug >= 5)
PerlIO_printf(DBILOGFP,
"DBD::Ingres::dbd_st_fetch SRE before SQL FETCH\n");
int
dbd_st_finish(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
EXEC SQL BEGIN DECLARE SECTION;
char *name = imp_sth->name;
EXEC SQL END DECLARE SECTION;
dTHR;
/* Cancel further fetches from this cursor. */
if (DBIc_ACTIVE(imp_sth))
{
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_st_finish(%s)\n",
imp_sth->name);
set_session(DBIc_PARENT_H(imp_sth));
EXEC SQL CLOSE :name;
}
DBIc_ACTIVE_off(imp_sth);
else {
if ($ENV{TEST_BOOLEAN}) {
plan tests => 21;
}
else {
plan tests => 8;
}
}
my $dbh = connect_db($dbname);
my $cursor;
ok(($dbh->ing_bool_to_str(undef) eq 'NULL'), 'testing ->ing_bool_to_str(undef)');
ok(($dbh->ing_bool_to_str(0) eq 'FALSE'), 'testing ->ing_bool_to_str(0)');
ok(($dbh->ing_bool_to_str(1) eq 'TRUE'), 'testing ->ing_bool_to_str(1)');
$SIG{__WARN__} = sub {}; # Disable warnings for next test
ok((!defined $dbh->ing_bool_to_str(2)), 'testing ->ing_bool_to_str(2)');
$SIG{__WARN__} = 'DEFAULT';
ok($dbh->do( "DROP TABLE $testtable" ),
'Basic drop table');
# CREATE TABLE OF APPROPRIATE TYPE
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable (val BOOLEAN) WITH STRUCTURE=HEAP"), 'Create table (BOOLEAN)');
}
else {
ok($dbh->do("CREATE TABLE $testtable (val BOOLEAN)"), 'Create table (BOOLEAN)');
}
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Insert prepare (BOOLEAN)');
ok($cursor->execute(1), 'Insert execute (BOOLEAN)');
ok($cursor->finish, 'Insert finish (BOOLEAN)');
ok($cursor = $dbh->prepare("SELECT val FROM $testtable WHERE val = ?"), 'Select prepare (BOOLEAN)');
ok($cursor->execute(1), 'Select execute (BOOLEAN)');
my $ar = $cursor->fetchrow_arrayref;
ok($ar && $ar->[0] == 1, 'Select fetch (BOOLEAN)')
or print STDERR 'Got "' . $ar->[0] . '", expected "' . 1 . "\".\n";
ok($cursor->finish, 'Select finish (BOOLEAN)');
ok($dbh->do("DROP TABLE $testtable"), 'Drop table (BOOLEAN)');
$dbh and $dbh->commit;
$dbh and $dbh->disconnect;
exit(0);
t/datatypes.t view on Meta::CPAN
my $types = $dbh->type_info_all();
for (1..$#{$types}) {
my $name = $types->[$_]->[$types->[0]->{TYPE_NAME}];
my $sqltype = $types->[$_]->[$types->[0]->{DATA_TYPE}];
my $searchable = $types->[$_]->[$types->[0]->{SEARCHABLE}];
my $nullable = $types->[$_]->[$types->[0]->{NULLABLE}];
my $params = $types->[$_]->[$types->[0]->{CREATE_PARAMS}];
my $val = $testvals{$name};
my $cursor;
next if (($name eq 'NCHAR') || ($name eq 'NVARCHAR'));
next if ($name eq 'BOOLEAN');
unless ($val) {
die "No default value for type $name\n";
}
# Update the type based on the create params
if ($params && $params =~ /max length/) {
t/datatypes.t view on Meta::CPAN
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable (val $name) WITH STRUCTURE=HEAP"),
"Create table ($name)");
}
else {
ok($dbh->do("CREATE TABLE $testtable (val $name)"),
"Create table ($name)");
}
# INSERT BOUND VALUE
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
"Insert prepare ($name)");
{
# By allowing the bind param to go out of scope we make sure the driver
# has either copied it or has all its ref counting on it right.
my $destroyval = $val;
ok($cursor->bind_param(1, $destroyval, { TYPE => $sqltype }),
"Insert bind param ($name)");
}
ok($cursor->execute,
"Insert execute ($name)");
ok($cursor->finish,
"Insert finish ($name)");
# SELECT VALUE
ok($cursor = $dbh->prepare("SELECT val FROM $testtable"),
"Select prepare ($name)");
ok($cursor->execute,
"Select execute ($name)");
my $ar = $cursor->fetchrow_arrayref;
ok($ar && $ar->[0] eq $val,
"Select fetch ($name)")
or print STDERR "Got '$ar->[0]', expected '$val'.\n";
ok($cursor->finish,
"Select finish ($name)");
# FETCH BOUND SELECTOR
if ($searchable) {
ok($cursor = $dbh->prepare("SELECT * FROM $testtable WHERE val = ?"),
"Select with bound selector prepare ($name)");
my $destroyval = $val;
ok($cursor->bind_param(1, $destroyval, { TYPE => $sqltype }),
"Select with bound selector bind_param ($name)");
undef $destroyval;
ok($cursor->execute,
"Select with bound selector execute ($name)");
$ar = $cursor->fetchrow_arrayref;
ok($ar && "$ar->[0]" eq "$val",
"Select with bound selector fetch ($name)")
or print STDERR "Got '$ar->[0]', expected '$val'.\n";
ok($cursor->finish,
"Select with bound selector finish ($name)");
} else {
# These dummies make it easier to set num_tests. We have to skip
# these tests because you can't select on some types.
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
}
# CLEAN UP FOR NULL STUFF
$dbh->do("DELETE FROM $testtable");
# INSERT NULL VALUE
if ($nullable) {
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
"Insert null prepare ($name)");
ok($cursor->bind_param(1, undef, { TYPE => $sqltype }),
"Insert null bind param ($name)");
ok($cursor->execute,
"Insert null execute ($name)");
ok($cursor->finish,
"Insert null finish ($name)");
# SELECT NULL VALUE
ok($cursor = $dbh->prepare("SELECT val FROM $testtable"),
"Select null prepare ($name)");
ok($cursor->execute,
"Select null execute ($name)");
ok(!defined ($cursor->fetchrow_arrayref->[0]),
"Select null fetch ($name)");
ok($cursor->finish,
"Select null finish ($name)");
} else {
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
ok(1, 'Dummy test.');
############################
unless (defined $dbname) {
plan skip_all => 'DBI_DBNAME and DBI_DSN aren\'t present';
}
else {
plan tests => 77;
}
my $dbh = connect_db($dbname);
my($cursor, $sth);
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable(id INTEGER4 not null, name CHAR(64)) WITH STRUCTURE=HEAP"),
'Create table');
}
else {
ok($dbh->do("CREATE TABLE $testtable(id INTEGER4 not null, name CHAR(64))"),
'Create table');
}
ok($dbh->do("INSERT INTO $testtable VALUES(1, 'Alligator Descartes')"),
'Insert(value)');
ok($dbh->do("DELETE FROM $testtable WHERE id = 1"),
'Delete');
ok($cursor = $dbh->prepare("SELECT * FROM $testtable WHERE id = ? ORDER BY id"),
'prepare(Select)');
ok($cursor->bind_param(1, 1, {TYPE => SQL_INTEGER}),
'Bind param 1 as 1');
ok($cursor->execute, 'Execute(select)');
my $row = $cursor->fetchrow_arrayref;
ok(!defined($row), 'Fetch from empty table');
ok($cursor->finish, 'Finish(select)');
ok(lc($cursor->{NAME}[0]) eq 'id', 'Column 1 name');
my $null = join ':', map int($_), @{$cursor->{NULLABLE}};
ok($null eq '0:1', 'Column nullablility');
ok($cursor->{TYPE}[0] == SQL_INTEGER, 'Column TYPE');
# test on ing_type, ing_ingtypes, ing_lengths..
my $ingtypes=$cursor->{ing_type};
ok(scalar @{$ingtypes} == 2, 'Special Ingres attribute "ing_type"');
my $ingingtypes=$cursor->{ing_ingtypes};
ok(scalar @{$ingingtypes} == 2, 'Special Ingres attribute "ing_ingtypes"');
my $inglengths=$cursor->{ing_lengths};
ok(scalar @{$inglengths} == 2, 'Special Ingres attribute "ing_lengths"');
# test on ing_ph_ingtypes, ing_ph_inglengths
ok($sth = $dbh->prepare("INSERT INTO $testtable(id, name) VALUES(?, ?)"),
'Prepare(insert with ?)');
my $ingphtypes=$cursor->{ing_ph_ingtypes};
ok(scalar @{$ingtypes} == 2, 'Special Ingres attribute "ing_ph_ingtypes"');
my $ingphlengths=$cursor->{ing_ph_inglengths};
ok(scalar @{$ingingtypes} == 2, 'Special Ingres attribute "ing_ph_inglengths"');
ok($sth = $dbh->prepare("INSERT INTO $testtable(id, name) VALUES(?, ?)"),
'Prepare(insert with ?) (again...)');
ok($sth->bind_param(1, 1, {TYPE => SQL_INTEGER}),
'Bind param 1 as 1');
ok($sth->bind_param(2, 'Henrik Tougaard', {TYPE => SQL_CHAR}),
'Bind param 2 as string');
ok($sth->execute, 'Execute(insert) with params');
ok($sth->execute( 2, 'Aligator Descartes'),
'Re-executing(insert)with params');
ok($cursor->execute, 'Re-execute(select)');
ok($row = $cursor->fetchrow_arrayref, 'Fetching row');
ok($row->[0] == 1, 'Column 1 value');
ok($row->[1] eq 'Henrik Tougaard', 'Column 2 value');
ok(!defined($row = $cursor->fetchrow_arrayref),
'Fetching past end of data');
ok($cursor->finish, 'finish(cursor)');
ok($cursor->execute(2), 'Re-execute[select(2)] for chopblanks');
ok($cursor->{ChopBlanks}, 'ChopBlanks on by default');
$cursor->{ChopBlanks} = 0;
ok(!$cursor->{ChopBlanks}, 'ChopBlanks switched off');
ok($row = $cursor->fetchrow_arrayref, 'Fetching row');
ok($row->[1] =~ /^Aligator Descartes\s+/, 'Column 2 value');
ok($cursor->finish, 'finish(cursor)');
ok($dbh->do(
"UPDATE $testtable SET id = 3 WHERE name = 'Alligator Descartes'"),
'do(Update) one row');
my $numrows;
ok($numrows = $dbh->do( "UPDATE $testtable SET id = id+1" ),
'do(Update) all rows');
ok($numrows == 2, 'Number of rows');
### Displays all records (for test of the test!)
###$sth=$dbh->prepare("select id, name FROM $testtable");
###$sth->execute;
###while (1) {
### $row=$sth->fetchrow_arrayref or last;
### print(DBI::neat_list($row), "\n");
###}
ok($sth=$dbh->prepare("SELECT id, name FROM $testtable WHERE id=3 FOR UPDATE OF name"),
'prepare for update');
ok($sth->execute, 'execute select for update');
ok($row = $sth->fetchrow_arrayref, 'Fetching row for update');
ok($dbh->do("UPDATE $testtable SET name='Larry Wall' WHERE CURRENT OF $sth->{CursorName}"), 'do cursor update');
ok($sth->finish, 'finish select');
ok($sth=$dbh->prepare("SELECT id, name FROM $testtable WHERE id=3"),
'prepare select after update');
ok($sth->execute, 'after update select execute');
ok($row = $sth->fetchrow_arrayref, 'fetching row for select_after_update');
ok($row->[1] =~ /^Larry Wall/, 'Col 2 value after update');
ok($sth->finish, 'finish');
### Displays all records (for test of the test!)
###$sth=$dbh->prepare("select id, name FROM $testtable");
ok($dbh->do("CREATE TABLE $testtable(id INTEGER4 not null, name LONG VARCHAR, bin BYTE VARYING(64)) WITH STRUCTURE=HEAP"), 'Create long varchar table');
}
else {
ok($dbh->do("CREATE TABLE $testtable(id INTEGER4 not null, name LONG VARCHAR, bin BYTE VARYING(64))"), 'Create long varchar table');
}
ok($dbh->do("INSERT INTO $testtable (id, name) VALUES(1, '')"),
'Long varchar zero-length insert');
ok($dbh->do("DELETE FROM $testtable WHERE id = 1"),
'Long varchar delete');
$cursor = $dbh->prepare("INSERT INTO $testtable (id, name) VALUES (?, ?)");
$cursor->bind_param(1, 1);
$cursor->bind_param(2, 'AaBb' x 1024, DBI::SQL_LONGVARCHAR);
ok($cursor->execute, 'Long varchar insert of 4096 bytes');
$cursor->finish;
$cursor = $dbh->prepare("UPDATE $testtable SET name = ? WHERE ID = 1");
$cursor->bind_param(1, 'CcDd' x 512, DBI::SQL_LONGVARCHAR);
ok($cursor->execute, 'Long varchar update of 2048 bytes');
$cursor->finish;
ok($cursor = $dbh->prepare("SELECT name FROM $testtable"),
'Long varchar prepare(select)');
ok($cursor->execute, 'Long varchar execute(select)');
$row = $cursor->fetchrow_arrayref;
ok(${$row}[0] eq 'CcDd' x 512, 'Long varchar fetch');
ok($cursor->finish, 'Long varchar finish');
# Reading a long varchar with LongReadLen = 0 should always return undef.
$dbh->{LongReadLen} = 0;
ok($dbh->{LongReadLen} == 0, 'Set LongReadLen = 0');
$cursor = $dbh->prepare("SELECT name FROM $testtable");
$cursor->execute;
$row = $cursor->fetchrow_arrayref;
ok(!defined $row->[0], 'Long varchar fetch with LongReadLen=0');
$cursor->finish;
# Reading a long varchar longer than LongReadLen with TruncOk set to 1
# should return the truncated value.
$dbh->{LongReadLen} = 5;
$dbh->{LongTruncOk} = 1;
$cursor = $dbh->prepare("SELECT name FROM $testtable");
$cursor->execute;
$row = $cursor->fetchrow_arrayref;
ok($row->[0] eq 'CcDdC',
'Long varchar fetch with LongReadLen=5 LongTruncOk=1');
$cursor->finish;
# Reading a long varchar longer than LongReadLen with TrunkOk set to 0
# should fail with an error.
$dbh->{LongReadLen} = 5;
$dbh->{LongTruncOk} = 0;
$cursor = $dbh->prepare("SELECT name FROM $testtable");
$cursor->execute;
eval {
$row = $cursor->fetchrow_arrayref;
};
ok(!defined $row, 'Long varchar fetch with LongReadLen=5 LongTruncOk=0');
$cursor->finish;
# Binary data testing
$dbh->do("DELETE FROM $testtable");
$cursor = $dbh->prepare("INSERT INTO $testtable (id, bin) VALUES (?, ?)");
$cursor->bind_param(1, 1);
$cursor->bind_param(2, "\0\1\2\3\0\1\2\3\0\1\2\3", DBI::SQL_VARBINARY);
ok($cursor->execute, 'Insert of binary data');
$cursor->finish;
$cursor = $dbh->prepare("SELECT bin FROM $testtable WHERE id = 1");
$cursor->execute;
$row = $cursor->fetchrow_arrayref;
ok(${$row}[0] eq "\0\1\2\3\0\1\2\3\0\1\2\3", 'Binary data fetch');
$cursor->finish;
#get_info
use DBI::Const::GetInfoType;
if ($dbh->ing_is_vectorwise) {
ok($dbh->get_info($GetInfoType{SQL_DBMS_NAME}) eq 'Vectorwise', 'get_info(DBMS name)');
}
else {
ok($dbh->get_info($GetInfoType{SQL_DBMS_NAME}) eq 'Ingres', 'get_info(DBMS name)');
}
else {
unless ($ENV{TEST_NCHAR} || $ENV{DBI_TEST_NCHAR}) {
plan skip_all => 'DBI_TEST_NCHAR isn\'t present';
exit 0;
}
plan tests => 22;
}
my $dbh = connect_db($dbname);
my $charset = get_charset();
my $cursor;
#
# Table creation/destruction. Can't do much else if this isn't working.
#
eval { local $dbh->{RaiseError}=0;
local $dbh->{PrintError}=0;
$dbh->do("DROP TABLE $testtable"); };
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable(id INTEGER4 not null, name CHAR(64)) WITH STRUCTURE=HEAP"),
'Basic create table');
# CREATE TABLE OF APPROPRIATE TYPE
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable (val NCHAR(10)) WITH STRUCTURE=HEAP"), 'Create table (NCHAR)');
}
else {
ok($dbh->do("CREATE TABLE $testtable (val NCHAR(10))"), 'Create table (NCHAR)');
}
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Insert prepare (NCHAR)');
ok($cursor->execute($data), 'Insert execute (NCHAR)');
ok($cursor->finish, 'Insert finish (NCHAR)');
ok($cursor = $dbh->prepare("SELECT val FROM $testtable"), 'Select prepare (NCHAR)');
ok($cursor->execute, 'Select execute (NCHAR)');
my $ar = $cursor->fetchrow_arrayref;
ok($ar && decode('utf-16le', $ar->[0]) eq ($data . (' ' x (10 - (length $data)))), 'Select fetch (NCHAR)')
or print STDERR 'Got "' . encode('utf-8', decode('utf-16le', $ar->[0])) . '", expected "' . encode('utf-8', $data . (' ' x (10 - (length $data)))) . "\".\n";
ok($cursor->finish, 'Select finish (NCHAR)');
ok($dbh->do("DROP TABLE $testtable"), 'Drop table (NCHAR)');
# CREATE TABLE OF APPROPRIATE TYPE
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable (val NVARCHAR(10)) WITH STRUCTURE=HEAP"), 'Create table (NVARCHAR)');
}
else {
ok($dbh->do("CREATE TABLE $testtable (val NVARCHAR(10))"), 'Create table (NVARCHAR)');
}
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Insert prepare (NVARCHAR)');
ok($cursor->execute($data), 'Insert execute (NVARCHAR)');
ok($cursor->finish, 'Insert finish (NVARCHAR)');
ok($cursor = $dbh->prepare("SELECT val FROM $testtable"), 'Select prepare (NVARCHAR)');
ok($cursor->execute, 'Select execute (NVARCHAR)');
$ar = $cursor->fetchrow_arrayref;
ok($ar && $ar->[0] eq encode('utf-16le', $data), 'Select fetch (NCHAR)')
or print STDERR 'Got "' . encode('utf-8', decode('utf-16le', $ar->[0])) . '", expected "' . encode('utf-8', $data) . "\".\n";
ok($cursor->finish, 'Select finish (NVARCHAR)');
ok($dbh->do("DROP TABLE $testtable"), 'Drop table (NVARCHAR)');
$dbh and $dbh->commit;
$dbh and $dbh->disconnect;
exit(0);
############################
unless (defined $dbname) {
plan skip_all => 'DBI_DBNAME and DBI_DSN aren\'t present';
}
else {
plan tests => 55;
}
my $dbh = connect_db($dbname);
my($cursor, $str);
eval { local $dbh->{RaiseError}=0;
local $dbh->{PrintError}=0;
$dbh->do("DROP TABLE $testtable"); };
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable(lol VARCHAR(12)) WITH STRUCTURE=HEAP"),
'CREATE TABLE');
}
else {
ok($dbh->do("CREATE TABLE $testtable(lol VARCHAR(12))"),
'CREATE TABLE');
}
$dbh->{ing_empty_isnull} = 0;
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
ok($cursor->execute(''), 'Execute INSERT');
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
ok((my $ar = $cursor->fetchrow_hashref), 'Fetch row');
ok(((defined $ar->{lol}) && ($ar->{lol} eq '')), 'Check whether string is empty');
ok($dbh->do(qq{DELETE FROM $testtable WHERE lol = ''}), 'DELETE row');
$dbh->{ing_empty_isnull} = 1;
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
ok($cursor->execute(''), 'Execute INSERT');
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
ok(($ar = $cursor->fetchrow_hashref), 'Fetch row');
ok((!defined $ar->{lol}), 'Check whether returned value is NULL');
ok($dbh->do("DELETE FROM $testtable WHERE lol IS NULL"), 'DELETE row');
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)", {ing_empty_isnull => 0}),
'Prepare INSERT');
ok($cursor->execute(''), 'Execute INSERT');
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
ok(($ar = $cursor->fetchrow_hashref), 'Fetch row');
ok(((defined $ar->{lol}) && ($ar->{lol} eq '')), 'Check whether string is empty');
ok($cursor->finish, 'Finish cursor');
ok($dbh->do("DROP TABLE $testtable"), 'DROP TABLE');
#
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable(lol INT4) WITH STRUCTURE=HEAP"),
'CREATE TABLE');
}
else {
ok($dbh->do("CREATE TABLE $testtable(lol INT4)"),
'CREATE TABLE');
}
$dbh->{ing_empty_isnull} = 0;
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
{
no warnings;
ok($cursor->bind_param(1, '', {TYPE => SQL_INTEGER}), 'bind_param');
}
ok($cursor->execute, 'Execute INSERT');
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
ok(($ar = $cursor->fetchrow_hashref), 'Fetch row');
ok(((defined $ar->{lol}) && ($ar->{lol} == 0)), 'Check whether int equals 0');
ok($dbh->do("DELETE FROM $testtable WHERE lol = 0"), 'DELETE row');
$dbh->{ing_empty_isnull} = 1;
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
{
no warnings;
ok($cursor->bind_param(1, '', { TYPE => SQL_INTEGER }), 'bind_param');
}
ok($cursor->execute, 'Execute INSERT');
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
ok(($ar = $cursor->fetchrow_hashref), 'Fetch row');
ok((!defined $ar->{lol}), 'Check whether int is NULL');
ok($dbh->do("DELETE FROM $testtable WHERE lol IS NULL"), 'DELETE row');
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
ok($cursor->execute("124"), 'Execute INSERT with PV which looks like number');
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
ok(($ar = $cursor->fetchrow_hashref), 'Fetch row');
ok($ar->{lol} == 124, 'Check whether int is equal to 124');
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
ok($cursor->bind_param_array(1, 1, SQL_INTEGER), 'bind_param_array, it used to crash');
ok($cursor->finish, 'finish INSERT cursor');
ok($dbh->do("DROP TABLE $testtable"), 'DROP TABLE');
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable(abc FLOAT) WITH STRUCTURE=HEAP"),
'CREATE TABLE');
}
else {
ok($dbh->do("CREATE TABLE $testtable(abc FLOAT)"),
'CREATE TABLE');
}
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
ok($cursor->bind_param_array(1, 1.1, SQL_DOUBLE), 'bind_param_array, it used to crash');
ok($cursor->finish, 'finish INSERT cursor');
ok($dbh->do("DROP TABLE $testtable"), 'DROP TABLE');
$dbh and $dbh->commit;
$dbh and $dbh->disconnect;
}
else {
unless ($ENV{DBI_TEST_UTF8}) {
plan skip_all => 'DBI_TEST_UTF8 isn\'t present';
exit 0;
}
plan tests => 12;
}
my $dbh = connect_db($dbname);
my($cursor, $str);
eval { local $dbh->{RaiseError}=0;
local $dbh->{PrintError}=0;
$dbh->do("DROP TABLE $testtable"); };
if ($dbh->ing_is_vectorwise) {
ok($dbh->do("CREATE TABLE $testtable(lol VARCHAR(12)) WITH STRUCTURE=HEAP"),
'Create table');
}
else {
ok($dbh->do("CREATE TABLE $testtable(lol VARCHAR(12))"),
'Create table');
}
ok($cursor = $dbh->prepare("INSERT INTO $testtable VALUES (?)"),
'Prepare INSERT');
ok($cursor->execute('ąść'), 'Execute INSERT');
$dbh->{ing_enable_utf8} = 0;
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
my $ar = $cursor->fetchrow_hashref;
ok(!utf8::is_utf8($ar->{lol}), 'Check whether string has UTF-8 flag');
$dbh->{ing_enable_utf8} = 1;
ok($cursor = $dbh->prepare("SELECT lol FROM $testtable"),
'Prepare SELECT');
ok($cursor->execute, 'Execute SELECT');
$ar = $cursor->fetchrow_hashref;
ok(utf8::is_utf8($ar->{lol}), 'Check whether string has UTF-8 flag');
ok(($ar->{lol} eq 'ąść'), 'Check string equality');
ok($cursor->finish, 'Finish cursor');
ok($dbh->do("DROP TABLE $testtable"), 'Drop table');
$dbh and $dbh->commit;
$dbh and $dbh->disconnect;
( run in 0.490 second using v1.01-cache-2.11-cpan-4d50c553e7e )