DBD-Ingres
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.
}
}
}
sub sql_close {
if ($sql_sth) {
$sql_sth->finish;
undef $sql_sth;
1;
} else {
carp "Ingperl: close with no open cursor, at"
if $sql_drh->{Warn};
1;
}
}
sub sql_fetch {
croak "Ingperl: No active cursor, at" unless $sql_sth;
my(@row) = $sql_sth->fetchrow();
$sql_rowcount = $sql_sth->rows();
unless (@row) {
&sql_close();
return wantarray ? () : undef;
}
if (wantarray) {
return @row;
} else { # wants a scalar
carp "Multi-column row retrieved in scalar context, at"
tie $Ingperl::sql_showerrors, 'Ingperl::var', 'showerror';
# *----------------------------------------
#
# Library function to execute a select and return first row
sub sql_eval_row1{
my $sth = $sql_dbh->prepare(@_);
return undef unless $sth;
$sth->execute or return undef;
my(@row) = $sth->fetchrow; # fetch one row
$sth->finish; # close the cursor
undef $sth;
@row;
}
# Library function to execute a select and return first col
sub sql_eval_col1{
my $sth = $sql_dbh->prepare(@_);
return undef unless $sth;
$sth->execute or return undef;
my ($row, @col);
while ($row = $sth->fetch){
push(@col, $row->[0]);
}
$sth->finish; # close the cursor
undef $sth;
@col;
}
package Ingperl::var;
use Carp (qw[carp croak confess]);
use strict;
sub TIESCALAR {
my ($class, $var) = @_;
get dbevent,
inquire_sql,
prepare to commit.
=item * sql_fetch
@values = &sql_fetch;
Fetch the next record of data returned from the last prepared
select statement. When all records have been returned &sql_fetch
will close the select statement cursor and return an empty array.
For example:
&sql('select * from iitables') || die $sql_error;
while(@values = &sql_fetch){
...
}
Null values are returned as undef elements of the array.
B<DBD:> C<&sql_fetch> can also be expressed as either C<&sql("fetch")>
or C<&sql_exec("fetch")> - to cater for Ingperl 1.0 scripts!
B<DBD:> C<&sql_fetch> will call C<&sql_close> when the last row of data
has been fetched. This has been the way it was supposed to be...
B<DBD:> C<&sql_fetch> will die with the error C<Ingperl: No active
cursor> if an error has occured in the C<&sql(select..)>-statement.
B<DBD:> C<$scalar = &sql_fetch> returns the first column of data if
C<$sql_sth-E<gt>{CompatMode}> is set; this is the default mode for
Ingperl and is the expected behaviour for Perl4. In Perl5 (and with
C<$sql_sth-E<gt>{CompatMode}> unset) the number of columns will be
returned. The warning C<Multi-column row retrieved in scalar context>
is given if C<$sql_sth-E<gt>{Warn}> is true.
B<DBD:> Text columns are returned with trailing blanks if
C<$sql_sth-E<gt>{CompatMode}> is set. Otherwise the trailings
blanks are stripped.
The default for C<Ingperl> is to have C<$sql_sth-E<gt>{CompatMode}>
set.
=item * sql_close
&sql_close;
This function needs to be called B<only> if you do not use C<&sql_fetch>
to fetch B<all> the records B<and> you wish to close the cursor as soon as
possible (to release locks etc). Otherwise ignore it. Always returns
true.
B<DBD:> If C<$sql_sth-E<gt>{Warn}> is false the warning C<Ingperl: close
with no open cursor> will be given whenever a closed cursor is reclosed.
The default behaviour is to omit the warning.
=back
IngPerl Functions to describe the currently prepared statement. These
functions all return an array with one element for each field in the
query result.
=over 4
Typically 0, <0 on error, 100=no more rows, 700=message, 710=dbevent.
=item * $sql_rowcount (read only)
After a successful Insert, Delete, Update, Select, Modify, Create Index,
Create Table As Select or Copy this variable holds the number of rows
affected.
=item * $sql_readonly (default 1)
If true then prepared sql statements are given read only cursors this is
generally a considerable performance gain.
B<DBD:> Not implemented. All cursors are readonly - there is no way to
modify the value of a cursor element, therefore no reason not to make
the cursors readonly. The value of this variable was ignored already in
Ingperl 2.0.
=item * $sql_showerrors (default 0)
If true then ingres error and warning messages are printed by
ingperl as they happen. Very useful for testing.
B<DBD:> Same as $sql_dbh->{PrintError}
=item * $sql_debug (default 0)
=head2 IngPerl Library Functions
=over 4
=item * sql_eval_row1
@row1 = &sql_eval_row1('select ...');
Execute a select statement and return the first row.
B<DBD:> This is executed in a separate cursor and can therefore be
executed while a &sql_fetch-loop is in progres.
=item * sql_eval_col1
@col1 = &sql_eval_col1('select ...');
Execute a select statement and return the first column.
B<DBD:> As &sql_eval_col1 this is executed in a separate cursor.
=head1 NOTES
The DBD::Ingres module has been modelled closely on Tim Bunce's
DBD::Oracle module and warnings that apply to DBD::Oracle and the
Oraperl emulation interface may also apply to the Ingperl emulation
interface.
Your mileage may vary.
=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
$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::Ingres 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>'.
=head2 state
$h->state (undef)
SQLSTATE is not implemented.
=head2 disconnect_all
Not implemented
=head2 commit and rollback invalidate open cursors
DBD::Ingres 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::Ingres wil possibly re-prepare the statement.
This is needed for
=head2 Cached statements
A new feature in DBI that is not implemented in DBD::Ingres.
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) && !dirty) {
warn("DBD::Ingres::commit(%s) invalidates %d active cursor(s)",
SvPV(dbh,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) && !dirty) {
warn("DBD::Ingres::rollback(%s) invalidates %d active cursor(s)",
SvPV(dbh,na), (int)DBIc_ACTIVE_KIDS(imp_dbh));
}
set_session(dbh);
++ imp_dbh->trans_no;
EXEC SQL ROLLBACK;
return sql_check(dbh);
}
imp_sth->ph_sqlda.sqld);
if (imp_sth->ph_sqlda.sqld > 0) {
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;
}
} else {
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");
EXEC SQL FETCH :name USING DESCRIPTOR :sqlda;
if (dbis->debug >= 5)
PerlIO_printf(DBILOGFP,
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);
if (dbis->debug >= 2)
# ===== connect / disconnect / errors =====
print "Checking connect to iidbdb\n";
&sql_test("connect iidbdb identified by fiksdba") || &failed();
print "Checking connected\n";
&sql_test("select date('now')");
print "Date and time now: ",&sql_fetch,"\n";
print "done\n\n";
print "Checking auto-close of cursor\n";
&sql_test("select date('now')"); # should prepare ok
print "failed\n" unless &sql_fetch; # should fetch ok
print "done\n\n";
&sql_test("rollback");
&sql_test("disconnect");
print "Checking disconnected\n";
# Don't show this error when it happens. The error (E_LQ002E) is
# used in the error checks below.
t/datatypes.t view on Meta::CPAN
$params =~ s/.*size=([0-9,]*).*/$1/;
my @sizes = split(/,/, $params);
$name .= $sizes[-1];
}
# CREATE TABLE OF APPROPRIATE TYPE
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.");
my $dbh = connect_db($num_test, $dbname);
$t = 1;
ok(2, $dbh->do("CREATE TABLE $testtable(id INTEGER4 not null, name CHAR(64))"),
"Create table", 1);
ok(0, $dbh->do("INSERT INTO $testtable VALUES(1, 'Alligator Descartes')"),
"Insert(value)", 1);
ok(0, $dbh->do("DELETE FROM $testtable WHERE id = 1"),
"Delete", 1);
ok(0, $cursor = $dbh->prepare("SELECT * FROM $testtable WHERE id = ? ORDER BY id"),
"prepare(Select)", 1);
ok(0, $cursor->bind_param(1, 1, {TYPE => SQL_INTEGER}),
"Bind param 1 as 1", 1);
ok(0, $cursor->execute, "Execute(select)", 1);
$row = $cursor->fetchrow_arrayref;
ok(0, !defined($row), "Fetch from empty table",
"Row is returned as: ".($row ? DBI->neat_list($row) : "''"));
ok(0, $cursor->finish, "Finish(select)", 1);
ok(0, lc($cursor->{NAME}[0]) eq "id", "Column 1 name",
"should be 'id' is '$cursor->{NAME}[0]'");
my $null = join ':', map int($_), @{$cursor->{NULLABLE}};
ok(0, $null eq '0:1',
"Column nullablility",
"Should be '0:1' is '$null'");
ok(0, $cursor->{TYPE}[0] == SQL_INTEGER,
"Column TYPE",
"should be '".SQL_INTEGER."' is '$cursor->{TYPE}[0]'");
# test on ing_type, ing_ingtypes, ing_lengths..
my $ingtypes=$cursor->{ing_type};
ok(0, scalar @{$ingtypes} == 2, "Special Ingres attribute 'ing_type'","wrong number of parameters");
my $ingingtypes=$cursor->{ing_ingtypes};
ok(0, scalar @{$ingingtypes} == 2, "Special Ingres attribute 'ing_ingtypes'","wrong number of parameters");
my $inglengths=$cursor->{ing_lengths};
ok(0, scalar @{$inglengths} == 2, "Special Ingres attribute 'ing_lengths'","wrong number of parameters");
# test on ing_ph_ingtypes, ing_ph_inglengths
ok(0, $sth = $dbh->prepare("INSERT INTO $testtable(id, name) VALUES(?, ?)"),
"Prepare(insert with ?)", 1);
my $ingphtypes=$cursor->{ing_ph_ingtypes};
ok(0, scalar @{$ingtypes} == 2, "Special Ingres attribute 'ing_ph_ingtypes'","wrong number of parameters");
my $ingphlengths=$cursor->{ing_ph_inglengths};
ok(0, scalar @{$ingingtypes} == 2, "Special Ingres attribute 'ing_ph_inglengths'","wrong number of parameters");
ok(0, $sth = $dbh->prepare("INSERT INTO $testtable(id, name) VALUES(?, ?)"),
"Prepare(insert with ?) (again...)", 1);
ok(0, $sth->bind_param(1, 1, {TYPE => SQL_INTEGER}),
"Bind param 1 as 1", 1);
ok(0, $sth->bind_param(2, "Henrik Tougaard", {TYPE => SQL_CHAR}),
"Bind param 2 as string" ,1);
ok(0, $sth->execute, "Execute(insert) with params", 1);
ok(0, $sth->execute( 2, 'Aligator Descartes'),
"Re-executing(insert)with params", 1);
ok(0, $cursor->execute, "Re-execute(select)", 1);
ok(0, $row = $cursor->fetchrow_arrayref, "Fetching row", 1);
ok(0, $row->[0] == 1, "Column 1 value",
"Should be '1' is '$row->[0]'");
ok(0, $row->[1] eq 'Henrik Tougaard', "Column 2 value",
"Should be 'Henrik Tougaard' is '$row->[1]'");
ok(0, !defined($row = $cursor->fetchrow_arrayref),
"Fetching past end of data",
"Row is returned as: ".($row ? DBI->neat_list($row) : "''"));
ok(0, $cursor->finish, "finish(cursor)", 1);
ok(0, $cursor->execute(2), "Re-execute[select(2)] for chopblanks", 1);
ok(0, $cursor->{ChopBlanks}, "ChopBlanks on by default", 1);
$cursor->{ChopBlanks} = 0;
ok(0, !$cursor->{ChopBlanks}, "ChopBlanks switched off", 1);
ok(0, $row = $cursor->fetchrow_arrayref, "Fetching row", 1);
ok(0, $row->[1] =~ /^Aligator Descartes\s+/, "Column 2 value",
"Should be 'Henrik Tougaard ... ' is '$row->[1]'");
ok(0, $cursor->finish, "finish(cursor)", 1);
ok(0, $dbh->do(
"UPDATE $testtable SET id = 3 WHERE name = 'Alligator Descartes'"),
"do(Update) one row", 1);
my $numrows;
ok(0, $numrows = $dbh->do( "UPDATE $testtable SET id = id+1" ),
"do(Update) all rows", 1);
ok(0, $numrows == 2, "Number of rows", "should be '2' is '$numrows'");
### 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(0, $sth=$dbh->prepare("SELECT id, name FROM $testtable WHERE id=3 FOR UPDATE OF name"),
"prepare for update", 1);
ok(0, $sth->execute, "execute select for update", 1);
ok(0, $row = $sth->fetchrow_arrayref, "Fetching row for update", 1);
ok(0, $dbh->do("UPDATE $testtable SET name='Larry Wall' WHERE CURRENT OF $sth->{CursorName}"), "do cursor update", 1);
ok(0, $sth->finish, "finish select", 1);
ok(0, $sth=$dbh->prepare("SELECT id, name FROM $testtable WHERE id=3"),
"prepare select after update", 1);
ok(0, $sth->execute, "after update select execute", 1);
ok(0, $row = $sth->fetchrow_arrayref, "fetching row for select_after_update", 1);
ok(0, $row->[1] =~ /^Larry Wall/, "Col 2 value after update",
"Should be 'Larry Wall...' is '$row->[1]'");
ok(0, $sth->finish, "finish", 1);
### Displays all records (for test of the test!)
### $row=$sth->fetchrow_arrayref or last;
### print(DBI::neat_list($row), "\n");
###}
ok(0, $dbh->do( "DROP TABLE $testtable" ), "Dropping table", 1);
ok(0, $dbh->do("CREATE TABLE $testtable(id INTEGER4 not null, name LONG VARCHAR, bin BYTE VARYING(64))"), "Create long varchar table", 1);
ok(0, $dbh->do("INSERT INTO $testtable (id, name) VALUES(1, '')"),
"Long varchar zero-length insert", 1);
ok(0, $dbh->do("DELETE FROM $testtable WHERE id = 1"),
"Long varchar delete", 1);
$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(0, $cursor->execute, "Long varchar insert of 4096 bytes", 1);
$cursor->finish;
$cursor = $dbh->prepare("UPDATE $testtable SET name = ? WHERE ID = 1");
$cursor->bind_param(1, "CcDd" x 512, DBI::SQL_LONGVARCHAR);
ok(0, $cursor->execute, "Long varchar update of 2048 bytes", 1);
$cursor->finish;
ok(0, $cursor = $dbh->prepare("SELECT name FROM $testtable"),
"Long varchar prepare(select)", 1);
ok(0, $cursor->execute, "Long varchar execute(select)", 1);
$row = $cursor->fetchrow_arrayref;
ok(0, ${$row}[0] eq 'CcDd' x 512, "Long varchar fetch", 1);
ok(0, $cursor->finish, "Long varchar finish", 1);
# Reading a long varchar with LongReadLen = 0 should always return undef.
$dbh->{LongReadLen} = 0;
ok(0, $dbh->{LongReadLen} == 0, "Set LongReadLen = 0", 1);
$cursor = $dbh->prepare("SELECT name FROM $testtable");
$cursor->execute;
$row = $cursor->fetchrow_arrayref;
ok(0, !defined $row->[0], "Long varchar fetch with LongReadLen=0", 1);
$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(0, $row->[0] eq 'CcDdC',
"Long varchar fetch with LongReadLen=5 LongTruncOk=1", 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(0, !defined $row, "Long varchar fetch with LongReadLen=5 LongTruncOk=0", 1);
$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(0, $cursor->execute, "Insert of binary data", 0);
$cursor->finish;
$cursor = $dbh->prepare("SELECT bin FROM $testtable WHERE id = 1");
$cursor->execute;
$row = $cursor->fetchrow_arrayref;
ok(0, ${$row}[0] eq "\0\1\2\3\0\1\2\3\0\1\2\3", "Binary data fetch", 1);
$cursor->finish;
#get_info
use DBI::Const::GetInfoType;
ok(0, $dbh->get_info($GetInfoType{SQL_DBMS_NAME}) eq "Ingres", "get_info(DBMS name)", 1);
#table_info
$sth = $dbh->table_info('','',$testtable);
my $href = $sth->fetchrow_hashref;
ok (0, ${$href}{table_name} eq $testtable, "table_info($testtable)", 1);
$sth = $dbh->table_info('','',"%".substr($testtable,2,4)."%");
$test++;
print "Testing: \$dbh->do( '$cmd' ):\n"
if $verbose;
( $dbh->do( $cmd ) )
and print( "ok $test\n" )
or print "not ok $test: $DBI::errstr\n";
}
sub run_test_prepare ($ ) {
my $cmd = shift;
my $cursor;
$test++;
print "Testing: $cursor = \$dbh->prepare( '$cmd' ):\n"
if $verbose;
( $cursor = $dbh->prepare( $cmd ) )
and print( "ok $test\n" )
or print "not ok $test: $DBI::errstr\n";
$test++;
print "Testing: $cursor \$cursor->execute:\n"
if $verbose;
( $cursor and $cursor->execute )
and print( "ok $test\n" )
or print "not ok $test: $DBI::errstr\n";
}
run_test qq[
CREATE TABLE $testtable
(
id INTEGER4,
name CHAR(64)
)
( run in 0.802 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )