DBD-InterBase

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

* 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()

Changes  view on Meta::CPAN

* 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;

MANIFEST  view on Meta::CPAN

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

dbdimp.c  view on Meta::CPAN

        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;

dbdimp.c  view on Meta::CPAN

        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;

dbdimp.c  view on Meta::CPAN


        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:

dbdimp.c  view on Meta::CPAN

         * 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? */

dbdimp.c  view on Meta::CPAN

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 */

dbdimp.c  view on Meta::CPAN

}


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++)

dbdimp.c  view on Meta::CPAN

            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  */

dbdimp.h  view on Meta::CPAN

#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.368 second using v1.01-cache-2.11-cpan-4d50c553e7e )