DBD-Firebird
view release on metacpan or search on metacpan
1.18 [2014-03-19]
* a bit more verbose ok() calls in 90-event-ithreads.t
* disable threaded event tests under AUTOMATED_TESTING
* Makefile.PL: check for 'ibase.h' presense in potential include dir [Tux]
* allow empty (but still defined) DBI_PASS/ISC_PASSWORD for tests [Tux]
* add support for FIREBIRD_DATABASE in tests' environment [Tux]
* adjust double tests to not fail with -Duselongdouble perl builds [Tux]
* fix statement attr returns and rework 40-alltypes.t [Tux]
* update installation notes wrt threaded perl and OpenSUSE [Tux]
* add missing pointer initialization (RT#92821, Vadim Belov)
* dbd_st_finish: ignore "cursor already closed" error when closing the cursor
* dbd_st_execute: finish the statement if still active (RT#92810, HMBRAND)
1.16 [2013-12-02]
* Implement event objects as blessed scalar refs
* include event creation/destruction in 60-leaks.t
* Fix for the reference test for softcommit
* Update README
* Fix comment about setting firebird home
* Add markdown version of the README file
* Update Makefile.PL removing old platforms
* test invalid lock resolution with 'throws_ok'
* 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
Firebird.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
t/001-client-version.t
t/01-connect.t
t/02-ib_embedded.t
t/03-dbh-attr.t
t/20-createdrop.t
t/30-insertfetch.t
t/31-prepare_cached.t
t/40-alltypes.t
t/41-bindparam.t
t/42-blobs.t
t/43-cursor.t
t/44-cursoron.t
t/45-datetime.t
t/46-listfields.t
t/47-nulls.t
t/48-numeric.t
t/49-scale.t
t/50-chopblanks.t
t/51-commit.t
t/60-leaks.t
t/61-settx.t
t/62-timeout.t
for (; x < send; ++x) {
if (!UTF8_IS_INVARIANT(*x))
break;
}
return x == send;
}
#endif
int create_cursor_name(SV *sth, imp_sth_t *imp_sth)
{
ISC_STATUS status[ISC_STATUS_LENGTH];
#define CURSOR_NAME_LEN 22
Newxz(imp_sth->cursor_name, CURSOR_NAME_LEN, char);
snprintf(imp_sth->cursor_name, CURSOR_NAME_LEN, "perl%16.16X", (uint32_t)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;
return TRUE;
}
void maybe_upgrade_to_utf8(imp_dbh_t *imp_dbh, SV *sv) {
if (imp_dbh->ib_enable_utf8) {
U8 *p;
STRLEN len;
p = (U8*)SvPV(sv, len);
do_error(sth, -1, "Database disconnected");
return FALSE;
}
/* init values */
count_item = 0;
imp_sth->count_item = 0;
imp_sth->affected = -1;
imp_sth->in_sqlda = NULL;
imp_sth->out_sqlda = NULL;
imp_sth->cursor_name = NULL;
imp_sth->dateformat = NULL;
imp_sth->timestampformat = NULL;
imp_sth->timeformat = NULL;
/* double linked list */
imp_sth->prev_sth = NULL;
imp_sth->next_sth = NULL;
if (attribs)
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 */
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_finish: nothing to do (not active)\n"));
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);
/* Ignore errors when closing already closed cursor (sqlcode -501).
May happen when closing "select * from sample" statement, which was
closed by the server because of a "drop table sample" statement.
There is no point to error-out here, since nothing bad has happened --
the statement is closed, just without we knowing. There is no resource
leak and the user can't and needs not do anything.
*/
if ((status[0] == 1) && (status[1] > 0)) {
long sqlcode = isc_sqlcode(status);
if (sqlcode != -501) {
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: %ld\n", fetch));
if (imp_sth->affected < 0)
imp_sth->affected = 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? */
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);
if ( imp_sth->param_values != NULL ) {
hv_undef(imp_sth->param_values);
imp_sth->param_values = NULL;
}
/* freeing in_sqlda */
if (imp_sth->in_sqlda)
{
int i;
return Nullsv;
av = newAV();
result = newRV_inc(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;
result = newSVpv(imp_sth->cursor_name, strlen(imp_sth->cursor_name));
}
/**************************************************************************/
else if (kl==11 && strEQ(key, "ParamValues"))
{
if (imp_sth->param_values == NULL)
return Nullsv;
result = newRV_inc((SV*)imp_sth->param_values);
}
else
return Nullsv;
unsigned char *charset_bytes_per_char;
};
/* 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 affected; /* number of affected rows */
char *dateformat;
char *timestampformat;
char *timeformat;
imp_sth_t *prev_sth; /* pointer to prev statement */
imp_sth_t *next_sth; /* pointer to next statement */
HV *param_values; /* For storing the ParamValues attribute */
t/30-insertfetch.t view on Meta::CPAN
ok( $dbh->do(qq{INSERT INTO $table VALUES (1, 'Alligator Descartes')}) );
#
# ... and delete it ...
#
ok($dbh->do("DELETE FROM $table WHERE id = 1"), "DELETE FROM $table");
#
# Now, try SELECT'ing the row out. This should fail.
#
ok(my $cursor = $dbh->prepare("SELECT * FROM $table WHERE id = 1"), 'SELECT');
ok($cursor->execute);
my $row = $cursor->fetchrow_arrayref;
$cursor->finish;
#
# Insert two new rows
#
ok( $dbh->do("INSERT INTO $table VALUES (1, 'Edwin Pratomo')") );
ok( $dbh->do("INSERT INTO $table VALUES (2, 'Daniel Ritz')") );
#
# Try selectrow_array
#
t/40-alltypes.t view on Meta::CPAN
# Create a new table
#
ok($dbh->do("CREATE TABLE $table (\n$def)"), "CREATE TABLE $table");
# Prepare insert
#
my $NAMES = join "," => @{$expected{NAME}};
my $sql = "INSERT INTO $table ($NAMES) VALUES ("
. join(',', ('?') x scalar @{$expected{VALUES}}) . ")";
my $cursor = $dbh->prepare($sql);
ok($cursor->execute(@{$expected{VALUES}}), "INSERT in $table");
ok(my $cursor2 = $dbh->prepare("SELECT * FROM $table", {
ib_timestampformat => '%Y-%m-%d %H:%M',
ib_dateformat => '%Y-%m-%d',
ib_timeformat => '%H:%M',
}), "PREPARE");
ok($cursor2->execute, "EXECUTE");
ok(my $res = $cursor2->fetchall_arrayref, 'FETCHALL arrayref');
is($cursor2->{NUM_OF_FIELDS}, scalar(@{$expected{VALUES}}), "Field count");
do {
my $i = 0;
for my $t ( @{ $expected{DEF} } ) {
my $e = $expected{VALUES}[$i];
if ( $t =~ /^FLOAT|DOUBLE(?: PRECISION)?|NUMERIC\(\d+,\d+\)$/ ) {
ok( abs( $res->[0][$i] - $e ) < 1e-10, "$t ~= $e" );
}
else {
is( $res->[0][$i], $e, "$t == $e" );
}
$i++;
}
};
is_deeply($cursor2->{$_}, $expected{$_}, "attribute $_") for qw( NAME NAME_lc NAME_uc TYPE PRECISION SCALE );
#
# Drop the test table
#
ok($dbh->do("DROP TABLE $table"), "DROP TABLE '$table'");
#
# Finally disconnect.
#
ok($dbh->disconnect(), "Disconnect");
t/41-bindparam.t view on Meta::CPAN
# Create the new table
#
my $def = qq{
CREATE TABLE $table (
id INTEGER NOT NULL,
name CHAR(64) CHARACTER SET UTF8
)
};
ok($dbh->do($def), "CREATE TABLE '$table'");
ok(my $cursor = $dbh->prepare("INSERT INTO $table VALUES (?, ?)"));
#
# Insert some rows
#
# Automatic type detection
my $numericVal = 1;
my $charVal = 'Alligator Descartes';
ok($cursor->execute($numericVal, $charVal));
# Does the driver remember the automatically detected type?
ok($cursor->execute("3", "Jochen Wiedmann"));
$numericVal = 2;
$charVal = "Tim Bunce";
ok($cursor->execute($numericVal, $charVal));
# Now try the explicit type settings
ok($cursor->bind_param(1, ' 4', SQL_INTEGER()));
ok($cursor->bind_param(2, 'Andreas König'));
ok($cursor->execute);
# Works undef -> NULL?
ok($cursor->bind_param(1, 5, SQL_INTEGER()));
ok($cursor->bind_param(2, undef));
ok($cursor->execute);
#
# Try various mixes of question marks, single and double quotes
#
ok($dbh->do("INSERT INTO $table VALUES (6, '?')"));
#
# And now retreive the rows using bind_columns
#
ok($cursor = $dbh->prepare("SELECT * FROM $table ORDER BY id"));
ok($cursor->execute);
my ($id, $name);
ok($cursor->bind_columns(undef, \$id, \$name), 'Bind columns');
ok($cursor->fetch);
is($id, 1, 'Check id 1');
is($name, 'Alligator Descartes', 'Check name');
ok($cursor->fetch);
is($id, 2, 'Check id 2');
is($name, 'Tim Bunce', 'Check name');
ok($cursor->fetch);
is($id, 3, 'Check id 3');
is($name, 'Jochen Wiedmann', 'Check name');
ok($cursor->fetch);
is($id, 4, 'Check id 4');
is($name, 'Andreas König', 'Check name');
ok($cursor->fetch);
is($id, 5, 'Check id 5');
is($name, undef, 'Check name');
ok($cursor->fetch);
is($id, 6, 'Check id 6');
is($name, '?', 'Check name');
# Have to call finish
ok($cursor->finish);
#
# Finally drop the test table.
#
ok($dbh->do("DROP TABLE $table"), "DROP TABLE '$table'");
# -- end test
t/42-blobs.t view on Meta::CPAN
#
my ($query);
my $sql_insert = "INSERT INTO $table VALUES(?, ?)";
# if ($ENV{'SHOW_BLOBS'} && open(OUT, ">" . $ENV{'SHOW_BLOBS'})) {
# print OUT $query;
# close(OUT);
# }
ok( my $cursor = $dbh->prepare($sql_insert), 'PREPARE INSERT blobs' );
# Insert 10 rows
for ( my $i = 0 ; $i < 10 ; $i++ ) {
ok( $cursor->execute( $i, $blob ), "EXECUTE INSERT row $i" );
}
#
# Now, try SELECT'ing the row out.
#
my $sql_sele = qq{SELECT * FROM $table WHERE id < 10 ORDER BY id};
ok( my $cursor2 = $dbh->prepare($sql_sele), 'PREPARE SELECT blobs' );
ok( $cursor2->execute(), "EXECUTE SELECT blobs" );
for ( my $i = 0 ; $i < 10 ; $i++ ) {
ok( ( my $row = $cursor2->fetchrow_arrayref ), 'FETCHROW' );
is( $$row[0], $i, 'ID matches' );
is( $$row[1], $blob, 'BLOB matches' );
# Some supplementary inserts
if ( $i >= 5 ) {
my $id = $i + 10;
ok( $cursor->execute( $id, $blob ), "EXECUTE INSERT $id" );
}
}
ok( $cursor2->finish );
ok( $cursor->finish );
#
# Finally drop the test table.
#
$dbh->{AutoCommit} = 1;
ok( $dbh->do("DROP TABLE $table"), "DROP TABLE '$table'" );
} # repeat test
t/43-cursor.t view on Meta::CPAN
my $def = qq{ CREATE TABLE $table (user_id INTEGER, comment VARCHAR(20)) };
my %values = (
1 => 'Lazy',
2 => 'Hubris',
6 => 'Impatience',
);
ok($dbh->do($def), "CREATE TABLE '$table'");
my $sql_insert = qq{INSERT INTO $table VALUES (?, ?)};
ok(my $cursor = $dbh->prepare($sql_insert), 'PREPARE INSERT');
ok($cursor->execute($_, $values{$_}), "INSERT id $_") for (keys %values);
$dbh->{AutoCommit} = 0;
ok (my $sth = $dbh->prepare("select comment from $table where user_id = ?"),"STH");
foreach my $id (sort keys %values) {
ok($sth->execute($id),"Excute for $id");
ok(my($c)=$sth->fetchrow_array(),"Fetch for $id");
is($c,$values{$id},"Comment for $id");
}
my $sql_sele = qq{SELECT * FROM $table WHERE user_id < 5 FOR UPDATE OF comment};
ok(my $cursor2 = $dbh->prepare($sql_sele), 'PREPARE SELECT');
ok($cursor2->execute, 'EXCUTE SELECT');
# Before..
while (my @res = $cursor2->fetchrow_array) {
ok($dbh->do(
"UPDATE $table SET comment = 'Zzzzz...' WHERE
CURRENT OF $cursor2->{CursorName}"),
"DO UPDATE where cursor name is '$cursor2->{CursorName}'"
);
}
ok(my $cursor3 = $dbh->prepare(
"SELECT * FROM $table WHERE user_id < 5"), 'PREPARE SELECT');
ok($cursor3->execute, 'EXECUTE SELECT');
# After..
while (my @res = $cursor3->fetchrow_array) {
is($res[1], 'Zzzzz...', 'FETCHROW result check');
}
ok($dbh->commit, 'COMMIT');
#
# Drop the test table
#
$dbh->{AutoCommit} = 1;
t/44-cursoron.t view on Meta::CPAN
#!/usr/local/bin/perl
#
#
# This is a test for CursorName attribute with AutoCommit On.
#
# 2011-01-29 stefansbv
# New version based on t/testlib.pl and Firebird.dbtest
# same test as 40cursor.t except ib_softcommit is enabled
use strict;
use warnings;
use Test::More;
use DBI qw(:sql_types);
use lib 't','.';
use TestFirebird;
t/44-cursoron.t view on Meta::CPAN
my $def = "CREATE TABLE $table(user_id INTEGER, comment VARCHAR(20))";
my %values = (
1 => 'Lazy',
2 => 'Hubris',
6 => 'Impatience',
);
ok($dbh->do($def), "CREATE TABLE '$table'");
my $sql_insert = "INSERT INTO $table VALUES (?, ?)";
ok(my $cursor = $dbh->prepare($sql_insert), 'PREPARE INSERT');
ok($cursor->execute($_, $values{$_}), "INSERT id $_") for (keys %values);
$dbh->{AutoCommit} = 0;
my $sql_sele = qq{SELECT * FROM $table WHERE user_id < 5 FOR UPDATE OF comment};
ok(my $cursor2 = $dbh->prepare($sql_sele), 'PREPARE SELECT');
ok($cursor2->execute, 'EXCUTE SELECT');
# Before..
while (my @res = $cursor2->fetchrow_array) {
ok($dbh->do(
"UPDATE $table SET comment = 'Zzzzz...' WHERE
CURRENT OF $cursor2->{CursorName}"),
"DO UPDATE where cursor name is '$cursor2->{CursorName}'"
);
}
ok(my $cursor3 = $dbh->prepare(
"SELECT * FROM $table WHERE user_id < 5"), 'PREPARE SELECT');
ok($cursor3->execute, 'EXECUTE SELECT');
# After..
while (my @res = $cursor3->fetchrow_array) {
is($res[1], 'Zzzzz...', 'FETCHROW result check');
}
#
# Drop the test table
#
$dbh->{AutoCommit} = 1;
ok( $dbh->do("DROP TABLE $table"), "DROP TABLE '$table'" );
t/45-datetime.t view on Meta::CPAN
END_OF_QUERY
ok(my $insert = $dbh->prepare($stmt), 'PREPARE INSERT');
ok($insert->execute(\@times, \@times, \@times));
#
# Select the values
#
ok(
my $cursor = $dbh->prepare(
"SELECT * FROM $table",
{
ib_timestampformat => 'TM',
ib_dateformat => 'TM',
ib_timeformat => 'TM',
}
)
);
ok($cursor->execute);
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < $fields; $i++) {
ok(( $is_match[$i]->($res) ), "field: $names->[$i] ($types->[$i])");
}
#
# Drop the test table
#
$dbh->{AutoCommit} = 1;
ok( $dbh->do("DROP TABLE $table"), "DROP TABLE '$table'" );
# NUM_OF_FIELDS should be zero (Non-Select)
ok(($cursor->{'NUM_OF_FIELDS'}), "NUM_OF_FIELDS == 0");
#
# Finally disconnect.
#
ok($dbh->disconnect());
t/46-listfields.t view on Meta::CPAN
my $def =<<"DEF";
CREATE TABLE $table (
id INTEGER PRIMARY KEY,
name VARCHAR(64)
)
DEF
ok($dbh->do($def), "CREATE TABLE $table");
my $sql_sele = qq{SELECT * FROM $table};
ok( my $cursor = $dbh->prepare($sql_sele), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
my ($types, $names, $fields, $nullable) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS NULLABLE)};
is( $fields, 2, 'CHECK FIELDS NUMBER' ); # 2 fields
is( $names->[0], 'ID', 'CHECK NAME for field 1' ); # id
is( $names->[1], 'NAME', 'CHECK NAME for field 1' ); # name
is( $nullable->[0], q{}, 'CHECK NULLABLE for field 1' ); # id
is( $nullable->[1], 1, 'CHECK NULLABLE for field 2' ); # name
is( $types->[0], SQL_INTEGER, 'CHECK TYPE for field 1' ); # id
is( $types->[1], SQL_VARCHAR, 'CHECK TYPE for field 2' ); # name
ok($cursor->finish, 'FINISH');
#
# Drop the test table
#
ok($dbh->do("DROP TABLE $table"), "DROP TABLE '$table'");
#
# Finally disconnect.
#
ok($dbh->disconnect, 'DISCONNECT');
t/47-nulls.t view on Meta::CPAN
ok( $dbh->do($def), qq{CREATE TABLE '$table'} );
#
# Test whether or not a field containing a NULL is returned correctly
# as undef, or something much more bizarre
#
my $sql_insert = qq{INSERT INTO $table VALUES ( NULL, 'NULL-valued id' )};
ok( $dbh->do($sql_insert), 'DO INSERT' );
my $sql_sele = qq{SELECT * FROM $table WHERE id IS NULL};
ok( my $cursor = $dbh->prepare($sql_sele), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok(my $rv = $cursor->fetchrow_arrayref, 'FETCHROW');
is($$rv[0], undef, 'UNDEFINED id');
is($$rv[1], 'NULL-valued id', 'DEFINED name');
ok($cursor->finish, 'FINISH');
#
# Test whether inserting NULL in a non-null field fails
#
my $table2 = find_new_table($dbh);
$dbh->do("CREATE table $table2(id integer not null)");
my $sth = $dbh->prepare("INSERT INTO $table2 VALUES(?)");
throws_ok { $sth->execute(undef) }
t/48-numeric.t view on Meta::CPAN
ok($insert->execute(
10.9,
10.9,
10.9),
'INSERT NUMBERS WITH VARIOUS PREC 3'
);
#
# Select the values
#
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table}, ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL arrayref');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $prec = $expected->{ $names->[$j] }{prec};
my $result = sprintf("%.${prec}f", $res->[$i][$j]);
my $corect = sprintf("%.${prec}f", $expected->{$names->[$j]}{test}{$i});
is($result, $corect, "Field: $names->[$j]");
}
}
t/63-doubles.t view on Meta::CPAN
my $id = 1;
ok($insert->execute( $id++, $_, $_ ), "Inserting $_" ) for @doubles;
# Insert positive numbers
ok($insert->execute( $id++, -$_, -$_ ), "Inserting -$_" ) for @doubles;
#
# Select the values
#
ok( my $cursor = $dbh->prepare( qq{SELECT id, flt, dbl FROM $table WHERE id=?} ),
'PREPARE SELECT' );
$id = 0;
for my $n (@doubles) {
$id++;
ok($cursor->execute($id), "EXECUTE SELECT $id ($n)");
ok((my $res = $cursor->fetchrow_arrayref), "FETCHALL arrayref $id ($n)");
cmp_deeply($res, [ $id, num($n, 1e-6), num($n, 1e-6) ], "row $id ($n)");
}
for my $n (@doubles) {
$id++;
ok($cursor->execute($id), "EXECUTE SELECT $id (-$n)");
ok((my $res = $cursor->fetchrow_arrayref), "FETCHALL arrayref $id (-$n)");
cmp_deeply($res, [ $id, num(-$n, 1e-6), num(-$n, 1e-6) ], "row $id (-$n)");
}
#
# Drop the test table
#
$dbh->{AutoCommit} = 1;
ok( $dbh->do("DROP TABLE $table"), "DROP TABLE '$table'" );
t/75-utf8.t view on Meta::CPAN
#
# Insert a row into the test table as raw SQL
#
ok( $dbh->do(qq{INSERT INTO $table VALUES (1, 'ASCII varchar', 'ASCII char', 'ASCII blob')}) );
#
# Now, see if selected data is plain ASCII as it should be
#
ok( my $cursor = $dbh->prepare("SELECT * FROM $table WHERE id = ?"),
'SELECT' );
ok( $cursor->execute(1) );
my $row = $cursor->fetchrow_arrayref;
$cursor->finish;
ok( !utf8::is_utf8($row->[0]), 'ASCII varchar' );
ok( !utf8::is_utf8($row->[1]), 'ASCII char' );
ok( !utf8::is_utf8($row->[2]), 'ASCII blob' );
#
# Insert with binding, still ASCII
#
ok( $dbh->do(
"INSERT INTO $table VALUES (2, ?, ?, ?)",
{},
'Still plain varchar',
'Still plain char',
'Still plain blob'
)
);
ok( $cursor->execute(2) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 2 );
is( $row->[1], 'Still plain varchar' );
is( $row->[2], 'Still plain char' );
is( $row->[3], 'Still plain blob' );
#
# Insert UTF8, embedded
#
ok( $dbh->do(
"INSERT INTO $table VALUES(3, 'Værчà r', 'Tæst', '€÷∞')")
);
ok( $cursor->execute(3) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 3 );
is( $row->[1], 'Værчà r' );
is( $row->[2], 'Tæst' );
is( $row->[3], '€÷∞', 'inline unicode blob' );
#
# Insert UTF8, binding
#
ok( $dbh->do(
"INSERT INTO $table VALUES(4, ?, ?, ?)",
{}, 'Værчà r', 'Tæst', '€÷∞'
)
);
ok( $cursor->execute(4) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 4 );
is( $row->[1], 'Værчà r' );
is( $row->[2], 'Tæst' );
is( $row->[3], '€÷∞', 'bound unicode blob' );
#
# Now turn off unicode support. things we fetch should not be flagged as
# unicode anymore
#
$dbh->{ib_enable_utf8} = 0;
ok( !$dbh->{ib_enable_utf8}, 'Turn off ib_enable_utf8' );
ok( $cursor->execute(4) );
$row = $cursor->fetchrow_arrayref;
$cursor->finish;
is( $row->[0], 4 );
is( $row->[1], encode_utf8('Værчà r'), 'non-unicode varchar' );
is( $row->[2], encode_utf8('Tæst'), 'non-unicode char' );
is( $row->[3], encode_utf8('€÷∞'), 'non-unicode blob' );
#
# ... and drop it.
#
ok($dbh->do("DROP TABLE $table"), "DROP TABLE '$table'");
t/92-bigdecimal10_read.t view on Meta::CPAN
# Expected fetched values
my @correct = (
[ '-922337203.6854775808', '922337203.6854775807' ],
[ '-0.0000000003', '0.0000000003' ],
[ '-0.0000000006', '0.0000000006' ],
[ '-0.0000000005', '0.0000000005' ],
[ '-0', '0' ],
);
# Select the values
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table} ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $result = qq{$res->[$i][$j]};
my $mresult = Math::BigFloat->new($result);
my $corect = $correct[$i][$j];
my $mcorect = Math::BigFloat->new($corect);
is($mresult, $mcorect, "Field: $names->[$j] is $corect");
t/92-bigdecimal_read.t view on Meta::CPAN
# Expected fetched values
my @correct = (
[ '-922337203685477.5808', '922337203685477.5807' ],
[ '-0.3', '0.3' ],
[ '-0.6', '0.6' ],
[ '-0.5', '0.5' ],
);
# Select the values
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table} ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $result = qq{$res->[$i][$j]};
my $mresult = Math::BigFloat->new($result);
my $corect = $correct[$i][$j];
my $mcorect = Math::BigFloat->new($corect);
is($mresult, $mcorect, "Field: $names->[$j] is $corect");
t/93-bigdecimal.t view on Meta::CPAN
my $stmt =<<"END_OF_QUERY";
INSERT INTO $table ( DEC_MIN, DEC_MAX)
VALUES (?, ?)
END_OF_QUERY
ok(my $insert = $dbh->prepare($stmt), 'PREPARE INSERT');
ok( $insert->execute(@$_), "INSERT '$_->[0]', '$_->[1]'" ) for @correct;
# Select the values
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table} ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $result = qq{$res->[$i][$j]};
my $mresult = Math::BigFloat->new($result);
my $corect = $correct[$i][$j];
my $mcorect = Math::BigFloat->new($corect);
is($mresult, $mcorect, "Field: $names->[$j]");
t/94-biginteger_read.t view on Meta::CPAN
INS
# DBI->trace(4, "trace.txt");
# Expected fetched values
my @correct = (
[ '-9223372036854775808', '9223372036854775807' ],
);
# Select the values
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table} ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
#my $scale = 0; # scale parameter
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $result = qq{$res->[$i][$j]};
my $mresult = Math::BigInt->new($result);
my $corect = $correct[$i][$j];
my $mcorect = Math::BigInt->new($corect);
t/95-biginteger.t view on Meta::CPAN
ok( $insert->execute( '-9223372036854775808', '9223372036854775807' ),
'INSERT MIN | MAX INTEGERS' );
# Expected fetched values
my @correct = (
[ '-9223372036854775808', '9223372036854775807' ],
);
# Select the values
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table} ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $result = qq{$res->[$i][$j]};
my $mresult = Math::BigInt->new($result);
my $corect = $correct[$i][$j];
my $mcorect = Math::BigInt->new($corect);
#ok($mresult->bacmp($mcorect) == 0, , "Field: $names->[$j]");
t/96-boolean.t view on Meta::CPAN
# Insert positive number
ok($insert->execute(1),
'INSERT 1 BOOLEAN VALUE (AGAIN)'
);
#
# Select the values
#
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table}, ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL arrayref');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $result = $res->[$i][$j];
my $corect = $expected->{$names->[$j]}{test}{$i};
if (defined($corect)) {
ok(
!($result xor $corect),
"Test $i, Field: $names->[$j], value '$res' matches expected '$corect'"
);
t/rt76506.t view on Meta::CPAN
ok( $dbh->do($def), qq{CREATE TABLE '$table'} );
#
# Prepare insert
#
my $stmt =<<"END_OF_QUERY";
INSERT INTO $table (CHAR_TEST) VALUES (?)
END_OF_QUERY
ok(my $cursor = $dbh->prepare($stmt), 'PREPARE INSERT');
ok($cursor->execute('TEST'), "INSERT in $table");
ok( my $cursor2 = $dbh->prepare(
"SELECT CHAR_TEST FROM $table",
),
'PREPARE SELECT'
);
ok($cursor2->execute, 'SELECT');
ok(my $hash_ref = $cursor2->fetchrow_hashref, 'FETCHALL hashref');
my $char_test = $hash_ref->{CHAR_TEST};
is(length $char_test, 10, 'Match length');
diag(">>$char_test<<");
ok($cursor2->finish, 'FINISH');
#
# Drop the test table
#
ok($dbh->do("DROP TABLE $table"), "DROP TABLE '$table'");
#
# Finally disconnect.
#
ok($dbh->disconnect(), 'DISCONNECT');
( run in 0.427 second using v1.01-cache-2.11-cpan-4d50c553e7e )