DBD-InterBase
view release on metacpan or search on metacpan
* manually applied patch sf #1068671 by dstreifert
Aug 8, 2005 - edpratomo
* fixed bug sf #1171702 (memory leak when doing TM type timestamp)
Jan 14, 2005 - danielritz
* better error handling for blobs
* 30insertfetch.t, 40blobs.t with more tests
* prevent a possible buffer overflow in date handling
* don't accept blob bind param for SELECT statement
* remove pointless 'ib_cursorname' attribute. DBD does it automatically
Nov 26, 2004 - danielritz
* add CLONE() method to support threads
* update test scripts for newer DBI
Mar 3, 2004 - edpratomo
* make bind value with blessed scalar work again
Feb 25, 2004 - edpratomo
* Fixed memory write error in dbd_db_login6()
* Switching AutoCommit attribute now also affects active softcommit flags.
April 4, 2002 - edpratomo, danielritz
* Added ib_softcommit attribute, isc_commit_retaining now needs to be enabled
explicitly by users.
April 4, 2002 - danielritz
* Added set_tx_param() with no param which now resets TPB.
April 4, 2002 - edpratomo
* Updated t/40cursoron.t, t/70nestedon.t to use ib_softcommit
* Makefile.PL code indented properly, now load dbd_dbi_arch_dir() only once,
now prompts with directory name, `make clean` cleans trace.txt
* Updated documentation in InterBase.pm and FAQ.pm
* Changed the semantic of -reserving in set_tx_param(), now uses hashref
instead of arrayref.
* Fixed warnings when compiled with DBI >= 1.20
* Ilya addressed bug #429820 and some bug in sth_ddl.
February 14, 2002 - ilyaverlinsky
* fix DATE, TIME, TIMESTAP problem
InterBase.pm view on Meta::CPAN
driver, and transparent for users. Column names are available via
$sth->{NAME} attributes.
=item * EXECUTE IMMEDIATE
Calling do() method without bind value(s) will do the same.
=item * CLOSE, OPEN, DECLARE CURSOR
$sth->{CursorName} is automagically available upon executing a "SELECT .. FOR
UPDATE" statement. A cursor is closed after the last fetch(), or by calling
$sth->finish().
=item * PREPARE, EXECUTE, FETCH
Similar functionalities are obtained by using prepare(), execute(), and
fetch() methods.
=back
=head1 COMPATIBILITY WITH DBIx::* MODULES
InterBase.pm view on Meta::CPAN
{
$dbh->{AutoCommit} = 0;
# same actions like above ....
$dbh->commit;
}
=item * Using $dbh->{ib_softcommit} = 1
This driver-specific attribute is available as of version 0.30. You may want
to look at t/40cursoron.t to see it in action.
=back
=head2 Why do nested statement handles break under AutoCommit mode?
The same explanation as above applies. The workaround is also
much alike:
{
$dbh->{AutoCommit} = 0;
typemap
t/00base.t
t/10dsnlist.t
t/20createdrop.t
t/30insertfetch.t
t/31prepare.t
t/40alltypes.t
t/40datetime.t
t/40bindparam.t
t/40blobs.t
t/40cursor.t
t/40cursoron.t
t/40doparam.t
t/40listfields.t
t/40nulls.t
t/40numrows.t
t/41numeric.t
t/50chopblanks.t
t/50commit.t
t/60leaks.t
t/61settx.t
t/62timeout.t
sqlda = NULL; \
} \
if (!(sqlda = (XSQLDA*) safemalloc(XSQLDA_LENGTH(len)))) \
do_error(sth, 2, "Fail to allocate XSQLDA"); \
memset(sqlda, 0, XSQLDA_LENGTH(len)); \
sqlda->sqln = len; \
sqlda->version = SQLDA_OK_VERSION; \
} while (0)
int create_cursor_name(SV *sth, imp_sth_t *imp_sth)
{
ISC_STATUS status[ISC_STATUS_LENGTH];
if ((imp_sth->cursor_name = (char *) safemalloc(22)) == NULL)
{
do_error(sth, IB_ALLOC_FAIL, "Cannot allocate cursor name.");
return FALSE;
}
sprintf(imp_sth->cursor_name, "perl%016.16x", imp_sth->stmt);
isc_dsql_set_cursor_name(status, &(imp_sth->stmt), imp_sth->cursor_name, 0);
if (ib_error_check(sth, status))
return FALSE;
else
return TRUE;
}
void dbd_init(dbistate_t *dbistate)
{
DBISTATE_INIT;
return FALSE;
}
/* init values */
count_item = 0;
imp_sth->count_item = 0;
imp_sth->fetched = -1;
imp_sth->in_sqlda = NULL;
imp_sth->out_sqlda = NULL;
imp_sth->cursor_name = NULL;
imp_sth->dateformat = NULL;
#ifdef IB_API_V6
imp_sth->timestampformat = NULL;
imp_sth->timeformat = NULL;
#endif
/* double linked list */
imp_sth->prev_sth = NULL;
imp_sth->next_sth = NULL;
if (!ib_commit_transaction(sth, imp_dbh))
{
ib_cleanup_st_execute(imp_sth);
return result;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: ib_commit_transaction succeed.\n"));
}
/* Declare a unique cursor for this query */
if (imp_sth->type == isc_info_sql_stmt_select_for_upd)
{
/* We free the cursor_name buffer in dbd_st_destroy. */
if (!create_cursor_name(sth, imp_sth))
{
ib_cleanup_st_execute(imp_sth);
return result;
}
}
switch (imp_sth->type)
{
case isc_info_sql_stmt_select:
* of rows that the SELECT will return.
*/
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_fetch: fetch result: %d\n", fetch));
if (imp_sth->fetched < 0)
imp_sth->fetched = 0;
if (fetch == 100)
{
/* close the cursor */
isc_dsql_free_statement(status, &(imp_sth->stmt), DSQL_close);
if (ib_error_check(sth, status))
return Nullav;
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "isc_dsql_free_statement succeed.\n"));
DBIc_ACTIVE_off(imp_sth); /* dbd_st_finish is no longer needed */
/* if AutoCommit on XXX. what to return if fails? */
int dbd_st_finish(SV *sth, imp_sth_t *imp_sth)
{
D_imp_dbh_from_sth;
ISC_STATUS status[ISC_STATUS_LENGTH];
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "dbd_st_finish\n"));
if (!DBIc_ACTIVE(imp_sth)) /* already finished */
return TRUE;
/* Close the cursor, not drop the statement! */
if (imp_sth->type != isc_info_sql_stmt_exec_procedure)
isc_dsql_free_statement(status, (isc_stmt_handle *)&(imp_sth->stmt), DSQL_close);
if (ib_error_check(sth, status))
return FALSE;
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_finish: isc_dsql_free_statement passed.\n"));
/* set statement to inactive - must be before ib_commit_transaction 'cos
commit can call dbd_st_finish function again */
}
void dbd_st_destroy(SV *sth, imp_sth_t *imp_sth)
{
D_imp_dbh_from_sth;
ISC_STATUS status[ISC_STATUS_LENGTH];
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_st_destroy\n"));
/* freeing cursor name */
FREE_SETNULL(imp_sth->cursor_name);
/* freeing in_sqlda */
if (imp_sth->in_sqlda)
{
int i;
XSQLVAR *var = imp_sth->in_sqlda->sqlvar;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_st_destroy: found in_sqlda..\n"));
for (i = 0; i < imp_sth->in_sqlda->sqld; i++, var++)
return Nullsv;
av = newAV();
result = newRV(sv_2mortal((SV*)av));
while(--i >= 0)
av_store(av, i, boolSV((imp_sth->out_sqlda->sqlvar[i].sqltype & 1) != 0));
}
/**************************************************************************/
else if (kl==10 && strEQ(key, "CursorName"))
{
if (imp_sth->cursor_name == NULL)
return Nullsv;
else
result = newSVpv(imp_sth->cursor_name, strlen(imp_sth->cursor_name));
}
else
return Nullsv;
if (cacheit)
{ /* cache for next time (via DBI quick_FETCH) */
SV **svp = hv_fetch((HV*)SvRV(sth), key, kl, 1);
sv_free(*svp);
*svp = result;
(void)SvREFCNT_inc(result); /* so sv_2mortal won't free it */
#endif
};
/* Define sth implementor data structure */
struct imp_sth_st
{
dbih_stc_t com; /* MUST be first element in structure */
isc_stmt_handle stmt;
XSQLDA *out_sqlda; /* for storing select-list items */
XSQLDA *in_sqlda; /* for storing placeholder values */
char *cursor_name;
long type; /* statement type */
char count_item;
int fetched; /* number of fetched rows */
char *dateformat;
#ifdef IB_API_V6
char *timestampformat;
char *timeformat;
#endif
imp_sth_t *prev_sth; /* pointer to prev statement */
t/30insertfetch.t view on Meta::CPAN
#
# ...and delete it........
#
Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
or DbiError($dbh->err, $dbh->errstr);
#
# Now, try SELECT'ing the row out. This should fail.
#
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
. " WHERE id = 1"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
my ($row, $errstr);
Test($state or (!defined($row = $cursor->fetchrow_arrayref) &&
(!defined($errstr = $cursor->errstr) ||
$cursor->errstr eq '')))
or DbiError($cursor->err, $cursor->errstr);
Test($state or $cursor->finish, "\$sth->finish failed")
or DbiError($cursor->err, $cursor->errstr);
Test($state or undef $cursor || 1);
#
# insert two new rows
#
Test($state or $dbh->do("INSERT INTO $table"
. " VALUES(1, 'Edwin Pratomo')"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $dbh->do("INSERT INTO $table"
. " VALUES(2, 'Daniel Ritz')"))
or DbiError($dbh->err, $dbh->errstr);
t/40alltypes.t view on Meta::CPAN
NUMERIC_AS_SMALLINT,
NUMERIC_AS_SMALLINT2,
NUMERIC_AS_INTEGER,
NUMERIC_AS_INTEGER2,
A_SIXTYFOUR
)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
END_OF_QUERY
};
Test($state or $cursor = $dbh->prepare($stmt))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute(
30000,
1000,
'Edwin',
'Edwin Pratomo',
'A string',
5000,
1.2,
1.44,
$timestamp,
'TOMORROW',
'NOW',
32.71,
-32.71,
123456.7895,
-123456.7895,
86753090000.8675309)
) or DbiError($cursor->err, $cursor->errstr);
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table", {
ib_timestampformat => '%Y-%m-%d %H:%M',
ib_dateformat => '%m-%d-%Y',
ib_timeformat => '%H:%M',
})) or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
Test($state or ($res = $cursor->fetchall_arrayref))
or DbiError($cursor->err, $cursor->errstr);
if (!$state) {
my ($types, $names, $fields) = @{$cursor}{TYPE, NAME, NUM_OF_FIELDS};
for (my $i = 0; $i < $fields; $i++) {
Test($state or ( $is_match[$i]->($res) ))
or DbiError(undef,
"wrong SELECT result for field $names->[$i]: $res->[0]->[$i]");
}
} else {
for (1..$num_of_fields) { Test($state) }
}
#
# Drop the test table
#
Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
# NUM_OF_FIELDS should be zero (Non-Select)
Test($state or (!$cursor->{'NUM_OF_FIELDS'}))
or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
$cursor->{'NUM_OF_FIELDS'});
Test($state or (undef $cursor) or 1);
}
t/40bindparam.t view on Meta::CPAN
#
# Create a new table; EDIT THIS!
#
Test($state or ($def = TableDefinition($table,
["id", "INTEGER", 4, 0],
["name", "CHAR", 64, $COL_NULLABLE, 'CHARACTER SET ISO8859_1']),
$dbh->do($def)))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor = $dbh->prepare("INSERT INTO $table"
. " VALUES (?, ?)"))
or DbiError($dbh->err, $dbh->errstr);
#
# Insert some rows
#
# Automatic type detection
my $numericVal = 1;
my $charVal = "Alligator Descartes";
Test($state or $cursor->execute($numericVal, $charVal))
or DbiError($dbh->err, $dbh->errstr);
# Does the driver remember the automatically detected type?
Test($state or $cursor->execute("3", "Jochen Wiedmann"))
or DbiError($dbh->err, $dbh->errstr);
$numericVal = 2;
$charVal = "Tim Bunce";
Test($state or $cursor->execute($numericVal, $charVal))
or DbiError($dbh->err, $dbh->errstr);
# Now try the explicit type settings
Test($state or $cursor->bind_param(1, " 4", SQL_INTEGER()))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->bind_param(2, "Andreas König"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
# Works undef -> NULL?
Test($state or $cursor->bind_param(1, 5, SQL_INTEGER()))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->bind_param(2, undef))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
#
# Try various mixes of question marks, single and double quotes
#
Test($state or $dbh->do("INSERT INTO $table VALUES (6, '?')"))
or DbiError($dbh->err, $dbh->errstr);
if ($mdriver eq 'mysql') {
Test($state or $dbh->do("INSERT INTO $table VALUES (7, \"?\")"))
or DbiError($dbh->err, $dbh->errstr);
}
Test($state or undef $cursor || 1);
#
# And now retreive the rows using bind_columns
#
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
. " ORDER BY id"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->bind_columns(undef, \$id, \$name))
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($ref = $cursor->fetch) && $id == 1 &&
$name eq 'Alligator Descartes')
or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
$id, $name, $ref, scalar(@$ref));
Test($state or (($ref = $cursor->fetch) && $id == 2 &&
$name eq 'Tim Bunce'))
or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
$id, $name, $ref, scalar(@$ref));
Test($state or (($ref = $cursor->fetch) && $id == 3 &&
$name eq 'Jochen Wiedmann'))
or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
$id, $name, $ref, scalar(@$ref));
Test($state or (($ref = $cursor->fetch) && $id == 4 &&
$name eq 'Andreas König'))
or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
$id, $name, $ref, scalar(@$ref));
Test($state or (($ref = $cursor->fetch) && $id == 5 &&
!defined($name)))
or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
$id, $name, $ref, scalar(@$ref));
Test($state or (($ref = $cursor->fetch) && $id == 6 &&
$name eq '?'))
or print("Query returned id = $id, name = $name, expected 6,?\n");
if ($mdriver eq 'mysql') {
Test($state or (($ref = $cursor->fetch) && $id == 7 &&
$name eq '?'))
or print("Query returned id = $id, name = $name, expected 7,?\n");
}
Test($state or undef $cursor or 1);
#
# Finally drop the test table.
#
Test($state or $dbh->do("DROP TABLE $table"))
or DbiError($dbh->err, $dbh->errstr);
}
t/40blobs.t view on Meta::CPAN
# Insert a row into the test table.......
#
my($query);
if (!$state) {
$query = "INSERT INTO $table VALUES(?, ?)";
if ($ENV{'SHOW_BLOBS'} && open(OUT, ">" . $ENV{'SHOW_BLOBS'})) {
print OUT $query;
close(OUT);
}
}
Test($state or $cursor = $dbh->prepare($query))
or DbiError($dbh->err, $dbh->errstr);
for (my $i = 0; $i < 10; $i++)
{
Test($state or $cursor->execute($i, $blob))
or DbiError($dbh->err, $dbh->errstr);
}
#
# Now, try SELECT'ing the row out.
#
Test($state or $cursor2 = $dbh->prepare("SELECT * FROM $table"
. " WHERE id < 10 ORDER BY id;"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor2->execute())
or DbiError($dbh->err, $dbh->errstr);
for (my $i = 0; $i < 10; $i++)
{
Test($state or (defined($row = $cursor2->fetchrow_arrayref)))
or DbiError($cursor2->err, $cursor2->errstr);
Test($state or (@$row == 2 && $$row[0] == $i && $$row[1] eq $blob))
or (ShowBlob($blob),
ShowBlob(defined($$row[1]) ? $$row[1] : ""));
if ($i >= 5)
{
Test($state or $cursor->execute($i + 10, $blob));
}
}
Test($state or $cursor2->finish)
or DbiError($cursor2->err, $cursor2->errstr);
Test($state or $cursor->finish)
or DbiError($cursor->err, $cursor->errstr);
Test($state or undef $cursor2 || 1)
or DbiError($cursor2->err, $cursor2->errstr);
Test($state or undef $cursor || 1)
or DbiError($cursor->err, $cursor->errstr);
#
# Finally drop the test table.
#
$dbh->{AutoCommit} = 1;
Test($state or $dbh->do("DROP TABLE $table"))
or DbiError($dbh->err, $dbh->errstr);
}
}
t/40cursor.t view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Id: 40cursor.t 324 2004-12-04 17:17:11Z danielritz $
#
# This is a test for CursorName attribute.
#
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
t/40cursor.t view on Meta::CPAN
'1', 'Lazy',
'2', 'Hubris',
'6', 'Impatience',
);
Test($state or ($dbh->do($def)))
or DbiError($dbh->err, $dbh->errstr);
my $stmt = "INSERT INTO $table VALUES (?, ?)";
Test($state or $cursor = $dbh->prepare($stmt))
or DbiError($dbh->err, $dbh->errstr);
for (keys %values) {
Test($state or $cursor->execute($_, $values{$_}))
or DbiError($cursor->err, $cursor->errstr);
}
$dbh->{AutoCommit} = 0;
$stmt = "SELECT * FROM $table WHERE user_id < 5 FOR UPDATE OF comment";
Test($state or ($cursor = $dbh->prepare($stmt)))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
if ($state) {
for (1..$rec_num) { Test($state) }
} else {
print "Before..\n";
while (my @res = $cursor->fetchrow_array) {
print join(", ", @res), "\n";
Test ($dbh->do(
"UPDATE ORDERS SET comment = 'Zzzzz...' WHERE
CURRENT OF $cursor->{CursorName}")
) or DbiError($dbh->err, $dbh->errstr);
}
}
Test($state or $cursor = $dbh->prepare(
"SELECT * FROM $table WHERE user_id < 5"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
if ($state) {
for (1..$rec_num) { Test($state) }
} else {
print "After..\n";
while (@res = $cursor->fetchrow_array) {
print join(", ", @res), "\n";
Test($res[1] eq 'Zzzzz...')
or DbiError(undef, "Unexpected SELECT result: $res[1]");
}
}
Test($state or $dbh->commit)
or DbiError($dbh->err, $dbh->errstr);
#
# Drop the test table
#
Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
Test($state or $dbh->commit)
or DbiError($dbh->err, $dbh->errstr);
# NUM_OF_FIELDS should be zero (Non-Select)
Test($state or (!$cursor->{'NUM_OF_FIELDS'}))
or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
$cursor->{'NUM_OF_FIELDS'});
Test($state or (undef $cursor) or 1);
}
t/40cursoron.t view on Meta::CPAN
#!/usr/local/bin/perl
#
# $Id: 40cursoron.t 324 2004-12-04 17:17:11Z danielritz $
#
# This is a test for CursorName attribute with AutoCommit On.
#
#
# Make -w happy
#
$test_dsn = '';
$test_user = '';
t/40cursoron.t view on Meta::CPAN
'1', 'Lazy',
'2', 'Hubris',
'6', 'Impatience',
);
Test($state or ($dbh->do($def)))
or DbiError($dbh->err, $dbh->errstr);
my $stmt = "INSERT INTO $table VALUES (?, ?)";
Test($state or $cursor = $dbh->prepare($stmt))
or DbiError($dbh->err, $dbh->errstr);
for (keys %values) {
Test($state or $cursor->execute($_, $values{$_}))
or DbiError($cursor->err, $cursor->errstr);
}
$stmt = "SELECT * FROM $table WHERE user_id < 5 FOR UPDATE OF comment";
Test($state or ($cursor = $dbh->prepare($stmt)))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
if ($state) {
for (1..$rec_num) { Test($state) }
} else {
print "Before..\n";
while (my @res = $cursor->fetchrow_array) {
print join(", ", @res), "\n";
Test ($dbh->do(
"UPDATE ORDERS SET comment = 'Zzzzz...' WHERE
CURRENT OF $cursor->{CursorName}")
) or DbiError($dbh->err, $dbh->errstr);
}
}
Test($state or $cursor = $dbh->prepare(
"SELECT * FROM $table WHERE user_id < 5"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
if ($state) {
for (1..$rec_num) { Test($state) }
} else {
print "After..\n";
while (@res = $cursor->fetchrow_array) {
print join(", ", @res), "\n";
Test($res[1] eq 'Zzzzz...')
or DbiError(undef, "Unexpected SELECT result: $res[1]");
}
}
#
# Drop the test table
#
Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
# NUM_OF_FIELDS should be zero (Non-Select)
Test($state or (!$cursor->{'NUM_OF_FIELDS'}))
or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
$cursor->{'NUM_OF_FIELDS'});
Test($state or (undef $cursor) or 1);
}
t/40datetime.t view on Meta::CPAN
INSERT INTO $table
(
A_TIMESTAMP,
A_DATE,
A_TIME
)
VALUES (?, ?, ?)
END_OF_QUERY
};
Test($state or $cursor = $dbh->prepare($stmt))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute(
\@times, \@times, \@times)
) or DbiError($cursor->err, $cursor->errstr);
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table", {
ib_timestampformat => 'TM',
ib_dateformat => 'TM',
ib_timeformat => 'TM',
})) or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
Test($state or ($res = $cursor->fetchall_arrayref))
or DbiError($cursor->err, $cursor->errstr);
if (!$state) {
my ($types, $names, $fields) = @{$cursor}{TYPE, NAME, NUM_OF_FIELDS};
for (my $i = 0; $i < $fields; $i++) {
Test($state or ( $is_match[$i]->($res) ))
or DbiError(undef,
"wrong SELECT result for field $names->[$i]: $res->[0]->[$i]");
}
} else {
for (1..$num_of_fields) { Test($state) }
}
#
# Drop the test table
#
Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
# NUM_OF_FIELDS should be zero (Non-Select)
Test($state or (!$cursor->{'NUM_OF_FIELDS'}))
or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
$cursor->{'NUM_OF_FIELDS'});
Test($state or (undef $cursor) or 1);
}
t/40doparam.t view on Meta::CPAN
my $numericVal = 1;
my $charVal = "Alligator Descartes";
Test($state or $dbh->do("INSERT INTO $table"
. " VALUES (?, ?)", undef, $numericVal, $charVal))
or DbiError($dbh->err, $dbh->errstr);
#
# And now retreive the rows using bind_columns
#
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
. " ORDER BY id"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->bind_columns(undef, \$id, \$name))
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($ref = $cursor->fetch) && $id == 1 &&
$name eq 'Alligator Descartes')
or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
$id, $name, $ref, scalar(@$ref));
# }
Test($state or undef $cursor or 1);
#
# Finally drop the test table.
#
Test($state or $dbh->do("DROP TABLE $table"))
or DbiError($dbh->err, $dbh->errstr);
}
t/40listfields.t view on Meta::CPAN
or DbiError($dbh->err, $dbh->errstr);
#
# Create a new table
#
Test($state or ($def = TableDefinition($table, @table_def),
$dbh->do($def)))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
my $res;
Test($state or (($res = $cursor->{'NUM_OF_FIELDS'}) == @table_def))
or DbiError($cursor->err, $cursor->errstr);
if (!$state && $verbose) {
printf("Number of fields: %s\n", defined($res) ? $res : "undef");
}
Test($state or ($ref = $cursor->{'NAME'}) && @$ref == @table_def
&& (lc $$ref[0]) eq $table_def[0][0]
&& (lc $$ref[1]) eq $table_def[1][0])
or DbiError($cursor->err, $cursor->errstr);
if (!$state && $verbose) {
print "Names:\n";
for ($i = 0; $i < @$ref; $i++) {
print " ", $$ref[$i], "\n";
}
}
Test($state or ($ref = $cursor->{'NULLABLE'}) && @$ref == @table_def
&& !($$ref[0] xor ($table_def[0][3] & $COL_NULLABLE))
&& !($$ref[1] xor ($table_def[1][3] & $COL_NULLABLE)))
or DbiError($cursor->err, $cursor->errstr);
if (!$state && $verbose) {
print "Nullable:\n";
for ($i = 0; $i < @$ref; $i++) {
print " ", ($$ref[$i] & $COL_NULLABLE) ? "yes" : "no", "\n";
}
}
Test($state or (($ref = $cursor->{TYPE}) && (@$ref == @table_def)
&& ($ref->[0] eq DBI::SQL_INTEGER())
&& ($ref->[1] eq DBI::SQL_VARCHAR() ||
$ref->[1] eq DBI::SQL_CHAR())))
or printf("Expected types %d and %d, got %s and %s\n",
&DBI::SQL_INTEGER(), &DBI::SQL_VARCHAR(),
defined($ref->[0]) ? $ref->[0] : "undef",
defined($ref->[1]) ? $ref->[1] : "undef");
Test($state or undef $cursor || 1);
#
# Drop the test table
#
Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
# NUM_OF_FIELDS should be zero (Non-Select)
Test($state or (!$cursor->{'NUM_OF_FIELDS'}))
or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
$cursor->{'NUM_OF_FIELDS'});
Test($state or (undef $cursor) or 1);
#
# Test different flavours of quote. Need to work around a bug in
# DBI 1.02 ...
#
my $quoted;
if (!$state) {
$quoted = eval { $dbh->quote(0, DBI::SQL_INTEGER()) };
}
Test($state or $@ or $quoted eq 0);
t/40nulls.t view on Meta::CPAN
#
# Test whether or not a field containing a NULL is returned correctly
# as undef, or something much more bizarre
#
Test($state or $dbh->do("INSERT INTO $table VALUES"
. " ( NULL, 'NULL-valued id' )"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
. " WHERE " . IsNull("id")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($rv = $cursor->fetchrow_arrayref) or $dbdriver eq 'CSV')
or DbiError($dbh->err, $dbh->errstr);
Test($state or (!defined($$rv[0]) and defined($$rv[1])) or
$dbdriver eq 'CSV')
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->finish)
or DbiError($dbh->err, $dbh->errstr);
Test($state or undef $cursor || 1);
#
# Finally drop the test table.
#
Test($state or $dbh->do("DROP TABLE $table"))
or DbiError($dbh->err, $dbh->errstr);
}
t/40numrows.t view on Meta::CPAN
# This section should exercise the sth->rows
# method by preparing a statement, then finding the
# number of rows within it.
# Prior to execution, this should fail. After execution, the
# number of rows affected by the statement will be returned.
#
Test($state or $dbh->do("INSERT INTO $table"
. " VALUES( 1, 'Alligator Descartes' )"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
. " WHERE id = 1")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($numrows = $cursor->rows) == 1 or ($numrows == -1))
or ErrMsgF("Expected 1 rows, got %s.\n", $numrows);
Test($state or ($numrows = TrueRows($cursor)) == 1)
or ErrMsgF("Expected to fetch 1 rows, got %s.\n", $numrows);
Test($state or $cursor->finish)
or DbiError($dbh->err, $dbh->errstr);
Test($state or undef $cursor or 1);
Test($state or $dbh->do("INSERT INTO $table"
. " VALUES( 2, 'Jochen Wiedmann' )"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
. " WHERE id >= 1")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($numrows = $cursor->rows) == 2 or ($numrows == -1))
or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);
Test($state or ($numrows = TrueRows($cursor)) == 2)
or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
Test($state or $cursor->finish)
or DbiError($dbh->err, $dbh->errstr);
Test($state or undef $cursor or 1);
Test($state or $dbh->do("INSERT INTO $table"
. " VALUES(3, 'Tim Bunce')"))
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
. " WHERE id >= 2")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($dbh->err, $dbh->errstr);
Test($state or ($numrows = $cursor->rows) == 2 or ($numrows == -1))
or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);
Test($state or ($numrows = TrueRows($cursor)) == 2)
or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
Test($state or $cursor->finish)
or DbiError($dbh->err, $dbh->errstr);
Test($state or undef $cursor or 1);
#
# Finally drop the test table.
#
Test($state or $dbh->do("DROP TABLE $table"))
or DbiError($dbh->err, $dbh->errstr);
}
t/41numeric.t view on Meta::CPAN
INSERT INTO $table
(
NUMERIC_AS_INTEGER,
NUMERIC_THREE_DIGITS,
NUMERIC_NO_DIGITS
)
VALUES (?, ?, ?)
END_OF_QUERY
};
Test($state or $cursor = $dbh->prepare($stmt))
or DbiError($dbh->err, $dbh->errstr);
# insert positive numbers
Test($state or $cursor->execute(
123456.7895,
86753090000.8675309,
10.9)
) or DbiError($cursor->err, $cursor->errstr);
# insert negative numbers
Test($state or $cursor->execute(
-123456.7895,
-86753090000.8675309,
-10.9)
) or DbiError($cursor->err, $cursor->errstr);
# insert with some variations in the precision part
Test($state or $cursor->execute(
123456.001,
80.080,
10.0)
) or DbiError($cursor->err, $cursor->errstr);
Test($state or $cursor->execute(
-123456.001,
-80.080,
-0.0)
) or DbiError($cursor->err, $cursor->errstr);
Test($state or $cursor->execute(
10.9,
10.9,
10.9)
) or DbiError($cursor->err, $cursor->errstr);
# select..
Test($state or $cursor = $dbh->prepare("SELECT * FROM $table")
) or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
Test($state or ($res = $cursor->fetchall_arrayref))
or DbiError($cursor->err, $cursor->errstr);
if (!$state) {
my ($types, $names, $fields) = @{$cursor}{TYPE, NAME, NUM_OF_FIELDS};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
Test($state or ( is_match($res, $i, $j) ))
or DbiError(undef,
"wrong SELECT result for row $i, field $names->[$j]: '$res->[$i]->[$j], expected: $correct[$i]->[$j]'");
}
}
} else {
for (1..$num_of_tests) { Test($state) }
}
#
# Drop the test table
#
Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
or DbiError($dbh->err, $dbh->errstr);
Test($state or $cursor->execute)
or DbiError($cursor->err, $cursor->errstr);
# NUM_OF_FIELDS should be zero (Non-Select)
Test($state or (!$cursor->{'NUM_OF_FIELDS'}))
or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
$cursor->{'NUM_OF_FIELDS'});
Test($state or (undef $cursor) or 1);
}
( run in 0.590 second using v1.01-cache-2.11-cpan-4d50c553e7e )