DBD-Informix

 view release on metacpan or  search on metacpan

dbdimp.ec  view on Meta::CPAN

 * Copyright 1994    Bill Hailes
 * Copyright 1996    Terry Nightingale
 * Copyright 1996-99 Jonathan Leffler
 * Copyright 1999    Bill Rothanburg <brothanb@fll-ro.dhl.com>
 * Copyright 2000-01 Informix Software Inc
 * Copyright 2000    Paul Palacios, C-Group Inc
 * Copyright 2001-03 IBM
 * Copyright 2002    Bryan Castillo <Bryan_Castillo@eFunds.com>
 * Copyright 2003-18 Jonathan Leffler
 *
 * You may distribute under the terms of either the GNU General Public
 * License or the Artistic License, as specified in the Perl README file.
 */

/*TABSTOP=4*/

#ifndef lint
/* Prevent over-aggressive optimizers from eliminating ID string */
const char jlss_id_dbdimp_ec[] = "@(#)$Id: dbdimp.ec,v 2018.1 2018/05/11 08:21:12 jleffler Exp $";
#endif /* lint */

#include <float.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>

#define MAIN_PROGRAM    /* Embed version information for JLSS headers */
#include "Informix.h"
#include "sqltoken.h"
#include "esqlutil.h"

/* Beware omitting the semi-colon! */
$include "esqlinfo.h";

#define L_CURLY '{'
#define R_CURLY '}'

/**
 ** JL 2000-01-20: ESQL/C versions 9.2x and later use 32 characters for
 ** usernames.  Earlier versions use 8 characters.  This is safe for the
 ** immediately foreseeable future, but it would be better if B69092 were
 ** fixed so this was not necessary and the #define from esqlc.h could be
 ** used instead of this $define -- DRY (Don't Repeat Yourself)!
 */
$define SQL_USERLEN1     33;

DBISTATE_DECLARE;

static const Sqlca zero_sqlca;
static const Link zero_link = { 0, 0, 0 };

/* One day, these will go!  Maybe... */
static void del_statement(imp_sth_t *imp_sth);
static int  dbd_ix_begin(imp_dbh_t *dbh);

/*
** Discussion of imp_sth->st_state (JL 2002-02-12).
** The State enumeration can take the values: Unused, Prepared,
** Allocated, Described, Declared, Opened, NoMoreData.
** -- Unused state means that there is no prepared statement, nor (by
**    definition) a declared cursor, nor any allocated descriptors.
** -- Prepared state means that there is a prepared statement but no
**    declared cursor nor any allocated descriptors. -JL-VERIFY
** -- Allocated state means that there is a prepared statement and a
**    descriptor for the input parameters (nm_idesc), but no declared
**    cursor nor any output descriptor (nm_odesc). -JL-VERIFY
** -- Described state means that there is a prepared statement and
**    descriptors for both input and output parameters. -JL-VERIFY
** -- Declared state means that there is both a prepared statement and a
**    declared cursor (which is currently closed) and descriptors for
**    both input and output parameters.
** -- Opened state means that the cursor is also open.
** -- NoMoreData state means that the cursor is closed, but that any
**    further fetches on the statement should always indicate NoMoreData
**    (SQLNOTFOUND).  This is a consequence of the DBI requirement that
**    the $sth->finish function should only be necessary for an early
**    exit from a fetch loop.  If you use $sth->finish on a NoMoreData
**    cursor, the state is changed to Declared.  If you use $sth->finish
**    on an open cursor, the cursor is closed and the state is changed
**    to Declared.  If you attempt $sth->finish on a cursor in any other
**    state, you will get an error.
*/

/* ================================================================= */
/* ==================== Driver Level Operations ==================== */
/* ================================================================= */

/* Official name for DBD::Informix module */
const char     *
dbd_ix_module(void)
{
    return(DBD_IX_MODULE);
}

/* Print message if debug level set high enough */
void
(dbd_ix_debug)(int n, const char *fmt, ...)
{
    fflush(stdout);
    /*
    ** TIMB sent an email dated 2007-04-23 stating that drivers should
    ** avoid using DBIS, because it is slow, especially on
    ** multi-threaded Perl.  However, the alternatives require a handle
    ** - and the dbd_ix_debug() function is not always invoked where
    ** there's a handle available.  The alternative is to test
    ** DBIc_TRACE_LEVEL(imp_xxh) at the call site (saving a function
    ** call to boot).  However, doing so is tricky.  The primary
    ** references to dbd_ix_debug() outside this file are in esqlc_v5.ec
    ** and esqlc_v6.ec; esqltest.ec provides a dummy implementation of
    ** this for the test code, and the references in link.c could be
    ** removed.  The esqlc_vN.ec code is used with no Perl whatsoever,
    ** so no imp_xxh is available.
    ** The calling code could pass the dbi_trace_level to those functions:
    **       dbd_ix_opendatabase(), dbd_ix_closedatabase(),
    **       dbd_ix_connect(), dbd_ix_disconnect(), dbd_ix_setconnection()
    */
    if (DBIS->debug >= n)
    {
        va_list args;
        char    buffer[1024];

        va_start(args, fmt);
        vsnprintf(buffer, sizeof(buffer), fmt, args);
        va_end(args);
        warn("%s", buffer);
    }
}

#ifdef DBD_IX_DEBUG_ENVIRONMENT
static void
dbd_ix_printenv(const char *s1, const char *s2)
{
    extern char **environ;
    char **envp = environ;
    char *env;

    fprintf(stderr, "ENV: %s %s - environ = 0x%08X\n", s1, s2, environ);
    while ((env = *envp++) != 0)
        fprintf(stderr, "0x%08X: %s\n", env, env);
}

dbdimp.ec  view on Meta::CPAN


    dbd_ix_enter(function);

    if (dbd_db_setconnection(imp_dbh) == 0)
    {
        dbd_ix_savesqlca(imp_dbh);
        dbd_ix_debug(1, "%s -- set connection failed", function);
        dbd_ix_exit(function);
        return(0);
    }

    dbd_ix_debug(1, "%s -- delete statements\n", function);
    dbd_ix_link_delchain(&imp_dbh->head, dbd_st_destroyer);
    dbd_ix_debug(1, "%s -- statements deleted\n", function);

    /* Rollback transaction before disconnecting */
    if (imp_dbh->is_loggeddb == True && imp_dbh->is_txactive == True)
        (void)dbd_ix_rollback(imp_dbh);

    dbd_ix_disconnect(imp_dbh->nm_connection);
    SvREFCNT_dec(imp_dbh->database);

    dbd_ix_sqlcode(imp_dbh);
    imp_dbh->is_connected = False;

    /* We assume that disconnect will always work       */
    /* since most errors imply already disconnected.    */
    DBIc_ACTIVE_off(imp_dbh);

    /* Record loss of connection in driver block */
    imp_drh->n_connections--;
    imp_drh->current_connection = 0;
    assert(imp_drh->n_connections >= 0);
    dbd_ix_link_delete(&imp_dbh->chain, noop);

    /* We don't free imp_dbh since a reference still exists  */
    /* The DESTROY method is the only one to 'free' memory.  */
    dbd_ix_exit(function);
    return 1;
}

void
dbd_ix_db_destroy(SV *dbh, imp_dbh_t *imp_dbh)
{
    static const char function[] = "dbd_ix_db_destroy";
    dbd_ix_enter(function);
    if (DBIc_is(imp_dbh, DBIcf_ACTIVE))
        dbd_ix_db_disconnect(dbh, imp_dbh);
    DBIc_off(imp_dbh, DBIcf_IMPSET);
    dbd_ix_exit(function);
}

/* ================================================================== */
/* =================== Statement Level Operations =================== */
/* ================================================================== */

/* Initialize a statement structure, allocating names */
static void
new_statement(imp_dbh_t *imp_dbh, imp_sth_t *imp_sth)
{
    static long     cursor_num = 0;

    sprintf(imp_sth->nm_stmnt,  "p_%09ld", cursor_num);
    sprintf(imp_sth->nm_cursor, "c_%09ld", cursor_num);
    sprintf(imp_sth->nm_obind,  "d_%09ld", cursor_num);
    sprintf(imp_sth->nm_ibind,  "b_%09ld", cursor_num);
    imp_sth->dbh      = imp_dbh;
    imp_sth->st_state = Unused;
    imp_sth->st_type  = 0;
    imp_sth->st_text  = 0;
    imp_sth->n_iblobs = 0;
    imp_sth->n_oblobs = 0;
    imp_sth->n_icols  = 0;
    imp_sth->n_rows   = 0;
    imp_sth->n_ocols  = 0;
    imp_sth->n_iudts  = 0;
    imp_sth->n_oudts  = 0;
    imp_sth->a_iudts  = 0;
    imp_sth->a_oudts  = 0;
    imp_sth->n_lvcsz  = 0;
    imp_sth->a_lvcsz  = 0;
    imp_sth->is_holdcursor   = False;
    imp_sth->is_scrollcursor = False;
    dbd_ix_link_add(&imp_dbh->head, &imp_sth->chain);
    imp_sth->chain.data = (void *)imp_sth;
    cursor_num++;
    /* Cleanup required for statement chain in imp_dbh */
    DBIc_on(imp_sth, DBIcf_IMPSET);
}

/* Close cursor */
static int
dbd_ix_close(imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_close";
    EXEC SQL BEGIN DECLARE SECTION;
    char           *nm_cursor = imp_sth->nm_cursor;
    EXEC SQL END DECLARE SECTION;

    dbd_ix_enter(function);

    assert(imp_sth->st_state == Opened);
    if (imp_sth->st_state == Opened)
    {
        EXEC SQL CLOSE :nm_cursor;
        dbd_ix_sqlcode(imp_sth->dbh);
        imp_sth->st_state = Declared;
        if (sqlca.sqlcode < 0)
        {
            dbd_ix_exit(function);
            return 0;
        }
    }
    dbd_ix_exit(function);
    return 1;
}

/* Release a complete SQL DESCRIPTOR, including any blobs */
static void dbd_ix_st_deallocate(char *p_name, int nblobs, int ncols)
{
    static const char function[] = "dbd_ix_st_deallocate";
    EXEC SQL BEGIN DECLARE SECTION;
    char *name = p_name;
    EXEC SQL END DECLARE SECTION;

    if (ncols > 0)
    {
        dbd_ix_debug(3, "%s() DEALLOCATE DESCRIPTOR %s\n", function, name);
        EXEC SQL DEALLOCATE DESCRIPTOR :name;
        if (sqlca.sqlcode != 0)
            dbd_ix_debug(0, "%s() - DEALLOCATE DESCRIPTOR failed %ld\n", function, sqlca.sqlcode);
    }
}

static void
free_udts(void **v_udts, int n_udts)
{
    int i;
    assert(v_udts != 0 && n_udts > 0);
    for (i = 0; i < n_udts; i++)
    {
        assert(v_udts[i] != 0);
        ifx_var_dealloc(&v_udts[i]);
    }
    free(v_udts);
}

/* Release all database and allocated resources for statement */
static void
del_statement(imp_sth_t *imp_sth)
{
    static const char function[] = "del_statement";
    EXEC SQL BEGIN DECLARE SECTION;
    char           *name;
    EXEC SQL END DECLARE SECTION;

    dbd_ix_debug(3, "\t-->> %s() 0x%08X\n", function, (long)imp_sth);

    if (dbd_db_setconnection(imp_sth->dbh) == 0)
    {
        dbd_ix_savesqlca(imp_sth->dbh);
        return;
    }

    switch (imp_sth->st_state)
    {
    case NoMoreData:
        dbd_ix_debug(5, "\t---- %s() state %s\n", function, "NoMoreData");
        /* FALLTHROUGH */

    case Opened:
        dbd_ix_debug(5, "\t---- %s() state %s\n", function, "Opened");
        name = imp_sth->nm_cursor;
        EXEC SQL CLOSE :name;
        dbd_ix_debug(3, "\t---- %s() CLOSE cursor %s\n", function, name);
        /* FALLTHROUGH */

    case Declared:
        dbd_ix_debug(5, "\t---- %s() state %s\n", function, "Declared");
        name = imp_sth->nm_cursor;
        EXEC SQL FREE :name;
        dbd_ix_debug(3, "\t---- %s() FREE cursor %s\n", function, name);
        /* FALLTHROUGH */

    case Described:
        dbd_ix_debug(5, "\t---- %s() state %s\n", function, "Described");
        /* FALLTHROUGH */

    case Allocated:
        dbd_ix_debug(5, "\t---- %s() state %s\n", function, "Allocated");
        dbd_ix_st_deallocate(imp_sth->nm_obind, imp_sth->n_oblobs, imp_sth->n_ocols);
        /* FALLTHROUGH */

    case Prepared:
        dbd_ix_debug(5, "\t---- %s() state %s\n", function, "Prepared");
        dbd_ix_st_deallocate(imp_sth->nm_ibind, imp_sth->n_iblobs, imp_sth->n_icols);
        name = imp_sth->nm_stmnt;
        EXEC SQL FREE :name;
        dbd_ix_debug(3, "\t---- %s() FREE statement %s\n", function, name);
        /* FALLTHROUGH */

    case Unused:
        dbd_ix_debug(5, "\t---- %s() state %s\n", function, "Unused");
        break;
    }

    if (imp_sth->n_lvcsz > 0)
        free(imp_sth->a_lvcsz);
    if (imp_sth->n_iudts > 0)
        free_udts(imp_sth->a_iudts, imp_sth->n_iudts);
    if (imp_sth->n_oudts > 0)
        free_udts(imp_sth->a_oudts, imp_sth->n_oudts);

    if (imp_sth->st_text != 0)
        SvREFCNT_dec(imp_sth->st_text);
    imp_sth->st_state = Unused;
    dbd_ix_link_delete(&imp_sth->chain, noop);
    DBIc_off(imp_sth, DBIcf_IMPSET);
    dbd_ix_debug(3, "\t<<-- %s() 0x%08X\n", function, (long)imp_sth);
}

/* Create the input descriptor for the specified number of items */
static int
dbd_ix_setbindnum(imp_sth_t *imp_sth, int items)
{
    static const char function[] = "dbd_ix_setbindnum";
    EXEC SQL BEGIN DECLARE SECTION;
    int  bind_size = items;
    char           *nm_ibind = imp_sth->nm_ibind;
    EXEC SQL END DECLARE SECTION;

    dbd_ix_enter(function);

    if (dbd_db_setconnection(imp_sth->dbh) == 0)
    {
        dbd_ix_exit(function);
        return 0;
    }

    if (items > imp_sth->n_icols)
    {
        if (imp_sth->n_icols > 0)

dbdimp.ec  view on Meta::CPAN

    int colno;
    int coltype;
    EXEC SQL END DECLARE SECTION;
    int nblobs = 0;

    for (colno = 1; colno <= ncols; colno++)
    {
        EXEC SQL GET DESCRIPTOR :nm_obind VALUE :colno :coltype = TYPE;

        /* dbd_ix_sqlcode(imp_sth->dbh); */
        if (coltype == SQLBYTES || coltype == SQLTEXT)
        {
            nblobs++;
        }
    }
    return(nblobs);
}

/* Process blobs (if any) */
static void
dbd_ix_blobs(imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_blobs";
    EXEC SQL BEGIN DECLARE SECTION;
    char           *nm_obind = imp_sth->nm_obind;
    loc_t           blob;
    int             colno;
    int coltype;
    EXEC SQL END DECLARE SECTION;
    int             n_ocols = imp_sth->n_ocols;

    dbd_ix_enter(function);
    imp_sth->n_oblobs = count_byte_text(nm_obind, n_ocols);
    dbd_ix_debug(5, "\t---- %s(): %ld BYTE/TEXT blobs\n", function, imp_sth->n_oblobs);
    if (imp_sth->n_oblobs == 0)
    {
        dbd_ix_exit(function);
        return;
    }

    /* Set blob location */
    if (blob_locate(&blob, imp_sth->blob_bind) != 0)
        croak("memory allocation error 3 in %s()\n", function);

    for (colno = 1; colno <= n_ocols; colno++)
    {
        EXEC SQL GET DESCRIPTOR :nm_obind VALUE :colno :coltype = TYPE;
        dbd_ix_sqlcode(imp_sth->dbh);
        if (coltype == SQLBYTES || coltype == SQLTEXT)
        {
            /* Tell ESQL/C how to handle this blob */
            EXEC SQL SET DESCRIPTOR :nm_obind VALUE :colno DATA = :blob;
            dbd_ix_sqlcode(imp_sth->dbh);
        }
    }
    dbd_ix_exit(function);
}

/*
** Workaround for CQ idsdb00247065: ESQL/C reporting error -1820 when
** reusing SQL DESCRIPTOR after reopening cursor
*/
static int
count_lvc(char *descname, int ncols)
{
    /*static const char function[] = "count_lvc";*/
    EXEC SQL BEGIN DECLARE SECTION;
    char *nm_obind = descname;
    int   colno;
    int   coltype;
    EXEC SQL END DECLARE SECTION;
    int n_lvc = 0;

    for (colno = 1; colno <= ncols; colno++)
    {
        EXEC SQL GET DESCRIPTOR :nm_obind VALUE :colno :coltype = TYPE;
        if (coltype == SQLLVARCHAR)
        {
            n_lvc++;
        }
    }
    return(n_lvc);
}

static int
dbd_ix_lvarchar(imp_sth_t *imp_sth)
{
    int nlvc;
    static const char function[] = "dbd_ix_lvarchar";
    EXEC SQL BEGIN DECLARE SECTION;
    char *nm_obind = imp_sth->nm_obind;
    int coltype;
    int colno;
    int collength;
    EXEC SQL END DECLARE SECTION;

    dbd_ix_enter(function);
    nlvc = count_lvc(nm_obind, imp_sth->n_ocols);

    if (nlvc > 0)
    {
        int i = 0;
        void *result = malloc(nlvc * sizeof(int));
        if (result == 0)
            die("%s: malloc() failed\n", function);

        imp_sth->n_lvcsz = nlvc;
        imp_sth->a_lvcsz = (int *)result;
        for (colno = 1; colno <= imp_sth->n_ocols; colno++)
        {
            EXEC SQL GET DESCRIPTOR :nm_obind VALUE :colno
                :coltype = TYPE, :collength = LENGTH;
            dbd_ix_sqlcode(imp_sth->dbh);
            if (coltype == SQLLVARCHAR)
            {
                imp_sth->a_lvcsz[i++] = collength;
            }
        }
        assert(i == nlvc);
    }
    dbd_ix_exit(function);

dbdimp.ec  view on Meta::CPAN


    dbd_ix_enter(function);
    nudts = count_udts(nm_obind, imp_sth->n_ocols);

    if (nudts > 0)
    {
        int i = 0;
        void *result = malloc(nudts * sizeof(void *));
        if (result == 0)
            die("%s: malloc() failed\n", function);

        imp_sth->n_oudts = nudts;
        imp_sth->a_oudts = (void **)result;
        for (colno = 1; colno <= imp_sth->n_ocols; colno++)
        {
            EXEC SQL GET DESCRIPTOR :nm_obind VALUE :colno :coltype = TYPE;
            dbd_ix_sqlcode(imp_sth->dbh);
            if (is_lvarcharptr_type(coltype))
            {
                /**
                ** MYK 2000-01-19 (ESQL/C 9.30).
                ** For the reasons unknown SQLCHAR is the only one that
                ** works.  Also, the manuals say LENGTH=0 sets to the actual
                ** value length.  In fact it just causes FETCH to fail.
                **
                ** JL 2007-08-24
                ** Careful scrutiny of the ESQL/C manual (chapter 16 in
                ** the ESQL/C 2.90 edition) shows that CLVCHARPTRTYPE
                ** (124) should work.  Some experimentation shows that
                ** ESQL/C distinguishes between host variables declared
                ** as 'lvarchar x[50];' and 'lvarchar *p;', declaring
                ** the first as an array of 50 char, and the second as a
                ** void pointer.  When messing with the pointer form,
                ** the generated C code calls ifx_var_init() to
                ** initialize the pointer.  Upgrade the imp_sth structure
                ** to include the fields n_iudts and n_oudts (number of
                ** input and output UDTs respectively), and arrays
                ** a_iudts and a_oudts to contain sets of pointers.
                ** The input side is there for symmetry rather than
                ** because it is used as yet.  This code allocates the
                ** array and initializes each element in turn.  The
                ** cleanup code has to release the variables with
                ** ifx_var_dealloc(), and then the arrays allocated
                ** above.
                */
                coltype = CLVCHARPTRTYPE;
                lvcp = 0;
                dbd_ix_debug(1, "\t---- %s: SET DESCRIPTOR on column number %d\n", function, colno);
                EXEC SQL SET DESCRIPTOR :nm_obind VALUE :colno DATA = :lvcp, TYPE = :coltype;
                dbd_ix_sqlcode(imp_sth->dbh);
                assert(lvcp != 0);
                imp_sth->a_oudts[i++] = lvcp;
            }
        }
        assert(i == nudts);
    }
    dbd_ix_exit(function);
    return(nudts);
}

/* Declare cursor for SELECT, EXECUTE PROCEDURE, or INSERT */
static int
dbd_ix_declare(imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_declare";
    EXEC SQL BEGIN DECLARE SECTION;
    char           *nm_stmnt = imp_sth->nm_stmnt;
    char           *nm_cursor = imp_sth->nm_cursor;
    EXEC SQL END DECLARE SECTION;

    dbd_ix_enter(function);
#ifdef SQ_EXECPROC
    assert(imp_sth->st_type == SQ_SELECT || imp_sth->st_type == SQ_INSERT ||
           imp_sth->st_type == SQ_EXECPROC);
#else
    assert(imp_sth->st_type == SQ_SELECT || imp_sth->st_type == SQ_INSERT);
#endif /* SQ_EXECPROC */
    assert(imp_sth->st_state == Described);
    dbd_ix_blobs(imp_sth);
    dbd_ix_lvarchar(imp_sth);    /* CQ idsdb00247065 */
    dbd_ix_udts(imp_sth);

    /* BR 1999-08-30: Hold Cursor -- Not necessarily correct... */
    if (imp_sth->dbh->is_modeansi == True &&
        DBI_AutoCommit(imp_sth->dbh) == True)
    {
        /* XPS 8.11 does not support hold cursors (Robert Wyrick <rob@wyrick.org>) */
        /* Note that the ESQL/C does support hold cursors. */
        /* The issue is whether the server does. */
        /* Assume 8.00 through 8.29 does not do so either.  8.30 may support them. */
        if (imp_sth->dbh->srvr_vrsn >= 800 && imp_sth->dbh->srvr_vrsn < 830)
            imp_sth->is_holdcursor = False;
        else
            imp_sth->is_holdcursor = True;
    }

#define print_tf(a) (a == True ? "True" : "False")
    dbd_ix_debug(3, "\t---- is_holdcursor   = %s", print_tf(imp_sth->is_holdcursor));
    dbd_ix_debug(3, "\t---- is_scrollcursor = %s", print_tf(imp_sth->is_scrollcursor));
    dbd_ix_debug(3, "\t---- is_insertcursor = %s", print_tf(imp_sth->is_insertcursor));
#undef print_tf

    if (imp_sth->is_scrollcursor == True)
    {
        if (imp_sth->is_holdcursor == True)
        {
            EXEC SQL DECLARE :nm_cursor SCROLL CURSOR WITH HOLD FOR :nm_stmnt;
        }
        else
        {
            EXEC SQL DECLARE :nm_cursor SCROLL CURSOR FOR :nm_stmnt;
        }
    }
    else
    {
        if (imp_sth->is_insertcursor && imp_sth->dbh->is_loggeddb &&
            DBI_AutoCommit(imp_sth->dbh) == True)
        {
            warn("insert cursor ineffective with AutoCommit enabled");
        }
        if (imp_sth->is_holdcursor == True)
        {
            EXEC SQL DECLARE :nm_cursor CURSOR WITH HOLD FOR :nm_stmnt;
        }
        else
        {
            EXEC SQL DECLARE :nm_cursor CURSOR FOR :nm_stmnt;
        }
    }
    dbd_ix_sqlcode(imp_sth->dbh);
    if (sqlca.sqlcode < 0)
    {
        dbd_ix_exit(function);
        return 0;
    }
    imp_sth->st_state = Declared;
    dbd_ix_exit(function);
    return 1;
}

/*
** dbd_ix_preparse() -- based on dbd_preparse() in DBD::ODBC 0.15
**
** Count the placeholders (?) parameters in the statement.
**
** The main-stream version also edits the string (in situ because the
** output will never be longer than the input) and recognizes both :9 (9 =
** digit string) positional parameters and :a (a = alphanumeric identifier)
** named parameters and converts them to ?.  However, this Informix version
** does not handle these non-standard extensions because the :a notation
** causes problems with Informix's FROM dbase:table notation, and the :9
** notation causes problems with DATETIME and INTERVAL literals!
**
** The code handles single-quoted literals and double-quoted delimited
** identifiers and ANSI SQL "--.*\n" comments and Informix "{.*}" comments.
** Note that it does nothing with "#.*\n" Perl/Shell comments.  Also note
** that it does not handle ODBC-style extensions.  The shorthand notation
** for these is identical to an Informix {} comment; longhand notation
** looks like "--*(details*)--" without the quotes.
*/

static int
dbd_ix_preparse(char *statement)
{
    static const char function[] = "dbd_ix_preparse";
    char            end_quote = '\0';
    char           *src;
    char           *dst;
    int             idx = 0;
    int             style = 0;
    int             laststyle = 0;
    char            ch;

    dbd_ix_debug(4, "\t-->> %s::%s(): <<%s>>\n", dbd_ix_module(), function, statement);
    src = statement;
    dst = statement;
    while ((ch = *src++) != '\0')
    {
        if (ch == end_quote)
            end_quote = '\0';
        else if (end_quote != '\0')
        {
            *dst++ = ch;
            continue;
        }
        else if (ch == '\'' || ch == '\"')
            end_quote = ch;

dbdimp.ec  view on Meta::CPAN

        ** better platform indicator, we can change that part of the
        ** condition.  Note that even if the DBD::Informix code only
        ** uses Sqlda structures, the NT platform will probably use
        ** SqlFreeMem().  You may run into crashes if SqlFreeMem() is
        ** not available for your version of ESQL/C on NT.
        */
        SqlFreeMem(u, SQLDA_FREE);
#else
        free(u);
#endif /* PERL_OBJECT && ESQLC_EFFVERSION */
    }
    dbd_ix_debug(1, "\t---- number of described fields %ld\n", (long)n);
    return(n);
}

int
dbd_ix_st_prepare(SV *sth, imp_sth_t *imp_sth, char *stmt, SV *attribs)
{
    static const char function[] = "dbd_ix_st_prepare";
    D_imp_dbh_from_sth;
    int  rc = 1;
    static const char ix_hc[] = "ix_CursorWithHold";
    static const char ix_sc[] = "ix_ScrollCursor";
    static const char ix_ic[] = "ix_InsertCursor";
    EXEC SQL BEGIN DECLARE SECTION;
    char           *statement = stmt;
    int             desc_count;
    char           *nm_stmnt;
    char           *nm_obind;
    EXEC SQL END DECLARE SECTION;

    dbd_ix_enter(function);

    if (stmt == 0 || *stmt == '\0')
    {
        /* No valid statement text */
        /* -402: Address of a host variable is NULL. */
        dbd_ix_db_seterror(imp_dbh, -402);
        dbd_ix_savesqlca(imp_dbh);
        dbd_ix_exit(function);
        return(0);
    }

    if ((rc = dbd_db_setconnection(imp_dbh)) == 0)
    {
        dbd_ix_savesqlca(imp_dbh);
        dbd_ix_exit(function);
        return(rc);
    }

    new_statement(imp_dbh, imp_sth);
    nm_stmnt = imp_sth->nm_stmnt;
    nm_obind = imp_sth->nm_obind;
    imp_sth->st_text = newSVpv(stmt, 0);

    /* Bill R. Code to allow the setting of Hold and Scroll Cursor Attribs */
    if (attribs == NULL)
        dbd_ix_debug(4, "\t---- %s - no attribs set", function);
    else
    {
        imp_sth->is_holdcursor = dbd_ix_st_attrib(attribs, ix_hc);
        imp_sth->is_scrollcursor = dbd_ix_st_attrib(attribs, ix_sc);
        imp_sth->is_insertcursor = dbd_ix_st_attrib(attribs, ix_ic);
    }

    dbd_ix_debug(4, "\t---- %s <<%s>>\n", function, statement);
    EXEC SQL PREPARE :nm_stmnt FROM :statement;
    dbd_ix_savesqlca(imp_dbh);
    dbd_ix_sqlcode(imp_dbh);
    if (sqlca.sqlcode < 0)
    {
        del_statement(imp_sth);
        dbd_ix_exit(function);
        return 0;
    }
    imp_sth->st_state = Prepared;

    /* Record the number of input parameters in the statement */
    DBIc_NUM_PARAMS(imp_sth) = dbd_ix_preparse(statement);

    /* Allocate space for that many parameters */
    if (dbd_ix_setbindnum(imp_sth, DBIc_NUM_PARAMS(imp_sth)) == 0)
    {
        del_statement(imp_sth);
        dbd_ix_exit(function);
        return 0;
    }

    desc_count = count_descriptors(nm_stmnt);
    /* SQL DESCRIPTORS must have WITH MAX of at least one (error -470) */
    if (desc_count == 0)
        desc_count = 1;
    dbd_ix_debug(3, "\t---- %s() ALLOCATE descriptor %s\n", function, nm_obind);
    EXEC SQL ALLOCATE DESCRIPTOR :nm_obind WITH MAX :desc_count;
    dbd_ix_sqlcode(imp_dbh);
    if (sqlca.sqlcode < 0)
    {
        del_statement(imp_sth);
        dbd_ix_exit(function);
        return 0;
    }
    imp_sth->st_state = Allocated;

    EXEC SQL DESCRIBE :nm_stmnt USING SQL DESCRIPTOR :nm_obind;
    dbd_ix_sqlcode(imp_dbh);
    if (sqlca.sqlcode < 0)
    {
        del_statement(imp_sth);
        dbd_ix_exit(function);
        return 0;
    }
    imp_sth->st_state = Described;
    imp_sth->st_type = sqlca.sqlcode;
    if (imp_sth->st_type == 0)
        imp_sth->st_type = SQ_SELECT;

    EXEC SQL GET DESCRIPTOR :nm_obind :desc_count = COUNT;
    dbd_ix_sqlcode(imp_dbh);
    if (sqlca.sqlcode < 0)
    {
        del_statement(imp_sth);
        dbd_ix_exit(function);
        return 0;
    }

    /* Record the number of fields in the cursor for DBI and DBD::Informix  */
    DBIc_NUM_FIELDS(imp_sth) = imp_sth->n_ocols = desc_count;

    /* Cannot create an INSERT cursor except on an insert statement */
    if (imp_sth->is_insertcursor == True && imp_sth->st_type != SQ_INSERT)
    {
        /* -481: Invalid statement name or statement was not prepared */
        /* Generated by 9.21.UC1 in response to declare cursor on update stmt */
        sqlca.sqlcode = -481;
        dbd_ix_sqlcode(imp_dbh);
        del_statement(imp_sth);
        dbd_ix_exit(function);
        return(0);
    }

    /**
    ** Only non-cursory statements need an output descriptor.
    ** Only cursory statements need a cursor declared for them.
    ** INSERT may yield an input descriptor (which will appear to be the
    ** output descriptor, such being the wonders of Informix).
    ** UPDATE and DELETE (and, indeed, INSERT, SELECT and EXECUTE
    ** PROCEDURE) statements would benefit from having a description of
    ** the input parameters, but this is not available.  SQL-92 defines
    ** DESCRIBE INPUT and DESCRIBE OUTPUT, but (as of 2000-08-01)
    ** Informix does not implement DESCRIBE INPUT.
    */
    if (imp_sth->st_type == SQ_SELECT)
        rc = dbd_ix_declare(imp_sth);
#ifdef SQ_EXECPROC  /* Defined for servers 5.00 and later, except perhaps 8.[012]x XPS */
    else if (imp_sth->st_type == SQ_EXECPROC && desc_count > 0)
        rc = dbd_ix_declare(imp_sth);
#endif  /* SQ_EXECPROC */
    else if (imp_sth->st_type == SQ_INSERT && desc_count > 0)
    {
        int nudts = dbd_ix_udts(imp_sth);

        dbd_ix_blobs(imp_sth);
        if (imp_sth->n_oblobs > 0 || nudts > 0)
        {
            /**
            ** Switch the nm_obind and nm_ibind names so that when
            ** dbd_ix_bindsv() is at work, it has an already populated SQL
            ** descriptor to work with, that already has the blobs set up
            ** correctly.
            */
            Name tmpname;
            int  t1;
            void **t2;
            dbd_ix_debug(3, "%s() switch descriptor names: old ibind %s\n", function, imp_sth->nm_ibind);
            dbd_ix_debug(3, "%s() switch descriptor names: old obind %s\n", function, imp_sth->nm_obind);
            strcpy(tmpname, imp_sth->nm_ibind);
            strcpy(imp_sth->nm_ibind, imp_sth->nm_obind);
            strcpy(imp_sth->nm_obind, tmpname);
            /* Switch lists of UDTs, too - need a structure! */
            t1 = imp_sth->n_iudts;
            imp_sth->n_iudts = imp_sth->n_oudts;
            imp_sth->n_oudts = t1;
            t2 = imp_sth->a_iudts;
            imp_sth->a_iudts = imp_sth->a_oudts;
            imp_sth->a_oudts = t2;
            dbd_ix_debug(3, "%s() switch descriptor names: new ibind %s\n", function, imp_sth->nm_ibind);
            dbd_ix_debug(3, "%s() switch descriptor names: new obind %s\n", function, imp_sth->nm_obind);
            imp_sth->n_icols = desc_count;
        }
        rc = 1;
        if (imp_sth->is_insertcursor == True)
            rc = dbd_ix_declare(imp_sth);
    }
    else
    {
        /**
        ** JL 2000-08-09:
        ** The IDS 7.30 and later servers nearly support describe for
        ** UPDATE.  However, it requires a special server configuration.
        ** Worse, the information returned by DESCRIBE is not usable.
        ** Bug B111987: DESCRIBE ON UPDATE STATEMENT GIVES INADEQUATE
        ** (AND UNUSABLE) INFORMATION.  The short description starts:
        ** [Summary: the ability to DESCRIBE the input parameters of an
        ** UPDATE might as well not exist -- it cannot be used in real
        ** life ESQL/C programs.]
        **
        ** The only reliable thing to do with the description of the
        ** input parameters to an UPDATE statement is to ignore it.
        */
        dbd_ix_debug(3, "\t---- %s() DEALLOCATE DESCRIPTOR %s\n", function, nm_obind);
        EXEC SQL DEALLOCATE DESCRIPTOR :nm_obind;
        imp_sth->st_state = Prepared;
        rc = 1;
    }

    dbd_ix_debug(2, "\t---- %s imp_sth->n_ocols: %d\n", function, imp_sth->n_ocols);

    dbd_ix_exit(function);
    return rc;
}

/* CLOSE cursor */
int
dbd_ix_st_finish(SV *sth, imp_sth_t *imp_sth, int gd_flag)
{
    static const char function[] = "dbd_ix_st_finish";
    dTHR;
    int rc;

    dbd_ix_enter(function);

    if ((rc = dbd_db_setconnection(imp_sth->dbh)) == 0)
    {
        dbd_ix_savesqlca(imp_sth->dbh);
    }
    else
    {
        if (imp_sth->st_state == Opened)
            rc = dbd_ix_close(imp_sth);
        else if (imp_sth->st_state == NoMoreData)
            imp_sth->st_state = Declared;
        else
            rc = 0;
        DBIc_ACTIVE_off(imp_sth);
    }

    dbd_ix_exit(function);
    return rc;
}

/* Free up resources used by the cursor or statement */
void
dbd_ix_st_destroy(SV *sth, imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_st_destroy";
    dbd_ix_enter(function);
    del_statement(imp_sth);
    dbd_ix_exit(function);
}

/* Convert DECIMAL to convenient string */
/* Patches problems with Informix conversion routines in pre-7.10 versions */
/* Don't forget that decimals are stored in a base-100 notation */
#if ESQLC_EFFVERSION < 710
static char *
decgen(dec_t *val, int collen)
{
    static char buffer[170];
    char *str;
    int dp = PRECDEC(collen);   /* Decimal places */
    int sf = PRECTOT(collen);   /* Significant digits */

    if (dp == 0xFF)
    {
        /* Floating point decimal */
        dec_sci(val, sf, 0, buffer, sizeof(buffer));
    }
    else
    {
        /* Fixed point decimal */
        dec_fix(val, dp, 0, buffer, sizeof(buffer));
    }
    str = buffer;
    while (*str == ' ')
        str++;
    /* Chop trailing blanks */
    str[byleng(str, strlen(str))] = '\0';
    return str;
}

#else

static char *
decgen(dec_t *val, int collen)
{
    static char buffer[170];
    char *str;
    int dp = PRECDEC(collen);   /* Decimal places */

    if (dp == 0xFF)
        dp = -1;
    dectoasc(val, buffer, sizeof(buffer), dp);
    str = buffer;
    while (*str == ' ')
        str++;
    /* Chop trailing blanks */
    str[byleng(str, strlen(str))] = '\0';
    return str;
}

#endif /* ESQLC_EFFVERSION */

/*
** Fetch a single row of data.
**
** Note the use of 'varchar' variables.  Given the sample code:
**
** #include <stdio.h>
** int main(int argc, char **argv)
** {
**     EXEC SQL BEGIN DECLARE SECTION;
**     char    cc[30];
**     varchar vc[30];
**     EXEC SQL END DECLARE SECTION;
**     EXEC SQL WHENEVER ERROR STOP;
**     EXEC SQL DATABASE Apt;
**     EXEC SQL CREATE TEMP TABLE Test(Col01 CHAR(20), Col02 VARCHAR(20));
**     EXEC SQL INSERT INTO Test VALUES("ABCDEFGHIJ     ", "ABCDEFGHIJ     ");
**     EXEC SQL SELECT Col01, Col01 INTO :cc, :vc FROM Test;
**     printf("Col01: cc = <<%s>>\n", cc);
**     printf("Col01: vc = <<%s>>\n", vc);
**     EXEC SQL SELECT Col02, Col02 INTO :cc, :vc FROM TestTable;
**     printf("Col02: cc = <<%s>>\n", cc);
**     printf("Col02: vc = <<%s>>\n", vc);
**     return(0);
** }
**
** The output looks like:
**      Col01: cc = <<ABCDEFGHIJ                   >>
**      Col01: vc = <<ABCDEFGHIJ          >>
**      Col02: cc = <<ABCDEFGHIJ                   >>
**      Col02: vc = <<ABCDEFGHIJ     >>
** Note that the data returned into 'cc' is blank padded to the length of
** the host variable, not the length of the database column, whereas 'vc'
** is blank-padded to the length of the database column for a CHAR column,
** and to the length of the inserted data in a VARCHAR column.
*/
AV *
dbd_ix_st_fetch(SV *sth, imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_st_fetch";
    AV  *av;
    EXEC SQL BEGIN DECLARE SECTION;
    char           *nm_cursor = imp_sth->nm_cursor;
    char           *nm_obind = imp_sth->nm_obind;
    varchar         coldata[256];
    long            coltype;
    long            collength;
    long            colind;
    char            colname[SQL_COLNAMELEN];
    int             index;
    char           *result;
    long            length;
    loc_t           blob;
    dec_t           decval;
    double          dblval;
    float           fltval;
    long            extypeid;
#ifdef SQLLVARCHAR
    lvarchar       *lvar = 0;
#endif
    EXEC SQL END DECLARE SECTION;
    D_imp_dbh_from_sth;
    int             is_char_type = 0; /* UTF8 patch */

    dbd_ix_enter(function);

    if (dbd_db_setconnection(imp_sth->dbh) == 0)
    {
        dbd_ix_savesqlca(imp_sth->dbh);
        dbd_ix_exit(function);
        return Nullav;
    }

    if (imp_sth->st_state == NoMoreData)
    {
        /* Simulate SQLNOTFOUND on a closed cursor */
        dbd_ix_debug(1, "%s: Simulate SQLNOTFOUND\n", function);
        sqlca.sqlcode = SQLNOTFOUND;
        dbd_ix_savesqlca(imp_sth->dbh);
        dbd_ix_sqlcode(imp_sth->dbh);
        dbd_ix_exit(function);
        return Nullav;
    }

    /* JL 2007-08-24: verified necessary - core dumps otherwise */
    dbd_ix_blobs(imp_sth); /* Fix -451 errors; Rich Jones <rich@annexia.org> */

    dbd_ix_debug(1, "\t---- %s: FETCH %s into %s\n", function, nm_cursor, nm_obind);
    EXEC SQL FETCH :nm_cursor USING SQL DESCRIPTOR :nm_obind;
    dbd_ix_savesqlca(imp_sth->dbh);
    dbd_ix_sqlcode(imp_sth->dbh);
    if (sqlca.sqlcode != 0)
    {
        if (sqlca.sqlcode != SQLNOTFOUND)
        {
            dbd_ix_debug(1, "\t---- %s -- FETCH failed\n", function);
        }
        else
        {
            /* Implicitly CLOSE cursor when no more data available */
            dbd_ix_close(imp_sth);
            imp_sth->st_state = NoMoreData;
            dbd_ix_debug(1, "\t---- %s -- SQLNOTFOUND\n", function);
        }
        dbd_ix_exit(function);
        return Nullav;
    }

    imp_sth->n_rows++;

    av = DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth);

    for (index = 1; index <= imp_sth->n_ocols; index++)
    {
        SV             *sv = AvARRAY(av)[index - 1];
        EXEC SQL GET DESCRIPTOR :nm_obind VALUE :index
                :coltype = TYPE, :collength = LENGTH,
                :colind = INDICATOR, :colname = NAME;
        dbd_ix_sqlcode(imp_sth->dbh);
        dbd_ix_debug(1, "\t---- %s colno %d: coltype = %d\n", function, index, coltype);

        is_char_type = 0;   /* UTF8 patch */

        if (colind != 0)
        {
            /* Data is null */
            result = coldata;
            length = 0;
            result[length] = '\0';
            sv_setsv(sv, &PL_sv_undef);
            /* warn("NULL Data: %d <<%s>>\n", length, result); */
        }
        else
        {
            switch (coltype)
            {
            case SQLINT:
            case SQLSERIAL:
            case SQLSMINT:
            case SQLDATE:
            case SQLDTIME:
            case SQLINTERVAL:
#ifdef SQLBOOL
            case SQLBOOL:
#endif  /* SQLBOOL */
#ifdef SQLSERIAL8
            case SQLSERIAL8:
#endif /* SQLSERIAL8 */
#ifdef SQLINT8
            case SQLINT8:
#endif /* SQLINT8 */
                /* These types always fit into a 256 character string */
                EXEC SQL GET DESCRIPTOR :nm_obind VALUE :index
                        :coldata = DATA;
                result = coldata;
                length = byleng(result, strlen(result));
                result[length] = '\0';
                /* warn("Normal Data: %d <<%s>>\n", length, result); */
                break;

dbdimp.ec  view on Meta::CPAN

                length = blob.loc_size;
                /* Warning - this data is not null-terminated! */
                /* warn("Blob Data: %d <<%*.*s>>\n", length, length, length,
                   result); */
                /* Data has been passed to Perl; mark it as such! */
                blob.loc_buffer = 0;
                blob_release(&blob, 0); /* 0 => do not delete files */
                break;

            default:
                colname[byleng(colname, strlen(colname))] = '\0';
                warn("%s - Unknown type code: %ld\n"
                      "(This type is probably IUS-specific and is not supported yet.)\n"
                      "coltype = %ld, collength = %ld, colind = %ld, colname = %s\n"
                        "-- value treated as NULL!\n",
                      function, coltype, coltype, collength, colind, colname);
                length = 0;
                result = coldata;
                result[length] = '\0';
                break;
            }

            if (sqlca.sqlcode < 0)
            {
                dbd_ix_sqlcode(imp_sth->dbh);
                *result = '\0';
            }

            sv_setpvn(sv, result, length);
            /* UTF8 patch */
            if(imp_dbh->enable_utf8 && is_char_type) {
                dbd_ix_debug(1, "\t---- UTF8 decode - colno %d: coltype = %d\n", index, coltype);
                sv_utf8_decode(sv);
            }

            if (result != coldata)
            {
                switch (coltype)
                {
#ifdef SQLLVARCHAR
                case CLVCHARPTRTYPE:
                case SQLLVARCHAR:
                    if (ifx_var_freevar(&lvar) < 0)
                        warn("Having problems freeing lvarchar");
                    break;
#endif  /* SQLLVARCHAR */
                case SQLBYTES:
                case SQLTEXT:
                    break;
                default:
                    free(result);
                    break;
                }
            }
        }
    }
    dbd_ix_exit(function);
    return(av);
}

/* Open a cursor */
static int
dbd_ix_open(imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_open";
    EXEC SQL BEGIN DECLARE SECTION;
    char           *nm_cursor = imp_sth->nm_cursor;
    char           *nm_ibind = imp_sth->nm_ibind;
    EXEC SQL END DECLARE SECTION;

    dbd_ix_enter(function);
    assert(imp_sth->st_state == Declared || imp_sth->st_state == Opened ||
            imp_sth->st_state == NoMoreData);
    /* Close currently open cursors - MODE ANSI databases give error otherwise */
    if (imp_sth->st_state == Opened)
    {
        dbd_ix_close(imp_sth);
        if (sqlca.sqlcode < 0)
        {
            dbd_ix_exit(function);
            return 0;
        }
    }
    assert(imp_sth->st_state == Declared || imp_sth->st_state == NoMoreData);

    if ((imp_sth->st_type != SQ_INSERT) && (imp_sth->n_icols > 0) )
        EXEC SQL OPEN :nm_cursor USING SQL DESCRIPTOR :nm_ibind;
    else
        EXEC SQL OPEN :nm_cursor;
    dbd_ix_sqlcode(imp_sth->dbh);
    dbd_ix_savesqlca(imp_sth->dbh);
    if (sqlca.sqlcode < 0)
    {
        dbd_ix_exit(function);
        return 0;
    }
    dbd_ix_reset_lvarchar_sizes(imp_sth);
    imp_sth->st_state = Opened;
    if (imp_sth->dbh->is_modeansi == True)
        imp_sth->dbh->is_txactive = True;
    imp_sth->n_rows = 0;
    dbd_ix_exit(function);
    return 1;
}

/* Parse statement for name of database -- what a pain! */
static void
dbd_ix_setdbname(const char *kw1, const char *kw2, imp_sth_t *sth)
{
    static const char function[] = "dbd_ix_setdbname";
    /**
    ** Scan through statement string, skipping comments ('{}' and '--\n'
    ** style), seeking (case-insensitively) the text of kw1 as the first
    ** word in the statement, and kw2 (if not null) as the second word in
    ** the statement.  The required database name is the third word in the
    ** statement.  Pain!  Oh the pain!  Why can't I have the database name
    ** returned to me by Informix?  About the only mercy is that we know
    ** that there is a major problem if the keywords are not found.
    ** OK: we created sqltoken() to handle this!
    */
    /* Where's the statement text? */
    char *tok = SvPV(sth->st_text, PL_na);
    const char *end = tok;

    dbd_ix_enter(function);
    tok = sqltoken(end, &end);
    /* Should be same as kw1 -- give or take case */
    if (DBIc_DBISTATE(sth)->debug >= 6)
        warn("%s: %s = <<%*.*s>>\n", function, kw1, (int)(end - tok), (int)(end - tok), tok);
    /* What's the Perl case-insensitive string comparison routine called? */
    if (kw2 != 0)
    {
        tok = sqltoken(end, &end);
        if (DBIc_DBISTATE(sth)->debug >= 6)
            warn("%s: %s = <<%*.*s>>\n", function, kw2, (int)(end - tok), (int)(end - tok), tok);
        /* Should be same as kw2 -- give or take case */
    }
    tok = sqltoken(end, &end);
    if (DBIc_DBISTATE(sth)->debug >= 6)
        warn("%s: dbn = <<%*.*s>>\n", function, (int)(end - tok), (int)(end - tok), tok);
    /* Should be the database name! */
    /* Must handle this correctly! */
    if (sth->dbh->database != 0)
        SvREFCNT_dec(sth->dbh->database);
    sth->dbh->database = newSVpv(tok, end - tok);
    if (DBIc_DBISTATE(sth)->debug >= 4)
        warn("new database name <<%s>>\n", SvPV(sth->dbh->database, PL_na));
    dbd_ix_exit(function);
}

static int
dbd_ix_exec(imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_exec";
    EXEC SQL BEGIN DECLARE SECTION;
    char           *nm_cursor = imp_sth->nm_cursor;
    char           *nm_stmnt = imp_sth->nm_stmnt;
    char           *nm_ibind = imp_sth->nm_ibind;
    EXEC SQL END DECLARE SECTION;
    imp_dbh_t *dbh = imp_sth->dbh;
    int rc = 1;
    Boolean exec_stmt = True;

    dbd_ix_enter(function);

    if (imp_sth->st_type == SQ_BEGWORK)
    {
        /* BEGIN WORK in a logged non-ANSI database with AutoCommit Off */
        /* will fail because we're already in a transaction. */
        /* Pretend it succeeded. */
        if (dbh->is_loggeddb == True && dbh->is_modeansi == False)
        {
            if (DBI_AutoCommit(dbh) == False)
            {
                dbd_ix_debug(1, "%s - AUTOCOMMIT Off => Pretend to BEGIN WORK succesfully\n", function);
                exec_stmt = False;
                sqlca.sqlcode = 0;
            }
        }
    }

    if (exec_stmt == True)
    {
        if (imp_sth->n_icols <= 0)
        {
            dbd_ix_debug(2, "\t---- EXECUTE %s - no parameters\n", nm_stmnt);
            EXEC SQL EXECUTE :nm_stmnt;
        }
        else if (imp_sth->st_type == SQ_INSERT && imp_sth->is_insertcursor == True)
        {
            dbd_ix_debug(2, "\t---- PUT %s USING %s\n", nm_cursor, nm_ibind);
            EXEC SQL PUT :nm_cursor USING SQL DESCRIPTOR :nm_ibind;
        }
        else
        {
            dbd_ix_debug(2, "\t---- EXECUTE %s USING %s\n", nm_stmnt, nm_ibind);
            EXEC SQL EXECUTE :nm_stmnt USING SQL DESCRIPTOR :nm_ibind;
        }
    }

    dbd_ix_sqlcode(dbh);
    dbd_ix_savesqlca(dbh);
    if (sqlca.sqlcode < 0)
    {
        dbd_ix_exit(function);
        return 0;
    }

    /**
    ** Here we need to analyse what was done...
    ** BEGIN WORK, COMMIT WORK, ROLLBACK WORK are important.
    ** So are DATABASE, CLOSE DATABASE, CREATE DATABASE.
    ** For SE, we could use START DATABASE or ROLLFORWARD DATABASE.
    ** Note that although it is unlikely to happen with Perl, the DATABASE
    ** operations other than CLOSE DATABASE can have a '?' place of the
    ** database name, so the same statement could be executed several times
    ** with different names, and the name is then available in nm_ibind.
    ** On the other hand, if it is not in nm_ibind, it has to be extracted
    ** from the statement string itself.
    */
    imp_sth->n_rows = sqlca.sqlerrd[2];
    switch (imp_sth->st_type)
    {
    case SQ_BEGWORK:
        dbd_ix_debug(3, "%s: BEGIN WORK\n", dbd_ix_module());
        dbh->is_txactive = True;
        assert(dbh->is_loggeddb == True);
        /* Even BEGIN WORK has to be committed if AutoCommit is On */
        if (DBI_AutoCommit(dbh) == True)
        {
            dbd_ix_debug(1, "%s - AUTOCOMMIT On => COMMIT WORK\n", function);
            rc = dbd_ix_commit(dbh);
        }
        break;
    case SQ_COMMIT:
        dbd_ix_debug(3, "%s: COMMIT WORK\n", dbd_ix_module());
        dbh->is_txactive = False;
        assert(dbh->is_loggeddb == True);
        /* In a logged database with AutoCommit Off, do BEGIN WORK */
        if (dbh->is_modeansi == False && DBI_AutoCommit(dbh) == False)
        {
            dbd_ix_debug(1, "%s - AUTOCOMMIT Off => BEGIN WORK\n", function);
            rc = dbd_ix_begin(dbh);
        }
        break;
    case SQ_ROLLBACK:
        dbd_ix_debug(3, "%s: ROLLBACK WORK\n", dbd_ix_module());
        dbh->is_txactive = False;
        assert(dbh->is_loggeddb == True);
        /* In a logged database with AutoCommit Off, do BEGIN WORK */
        if (dbh->is_modeansi == False && DBI_AutoCommit(dbh) == False)
        {
            dbd_ix_debug(1, "%s - AUTOCOMMIT Off => BEGIN WORK\n", function);
            rc = dbd_ix_begin(dbh);
        }
        break;
    case SQ_DATABASE:
        dbh->is_txactive = False;
        dbd_ix_setdbtype(dbh);
        dbd_ix_setdbname("DATABASE", 0, imp_sth);
        break;
    case SQ_CREADB:
        dbh->is_txactive = False;
        dbd_ix_setdbtype(dbh);
        dbd_ix_setdbname("CREATE", "DATABASE", imp_sth);
        break;
    case SQ_STARTDB:
        dbh->is_txactive = False;
        dbd_ix_setdbtype(dbh);
        dbd_ix_setdbname("START", "DATABASE", imp_sth);
        break;
    case SQ_RFORWARD:
        dbh->is_txactive = False;
        dbd_ix_setdbtype(dbh);
        dbd_ix_setdbname("ROLLFORWARD", "DATABASE", imp_sth);
        break;
    case SQ_CLSDB:
        /**
        ** CLOSE DATABASE -- no transactions, no autocommit, etc.
        ** With 6.00 upwards, the connection to the server still exists
        ** With 5.00, if the database was remote, then the connection
        ** is broken by close database; otherwise, it remains.  Assume
        ** it still exists until further notice...
        */
        dbh->is_txactive = False;
        dbh->is_modeansi = False;
        dbh->is_onlinedb = False;
        dbh->is_loggeddb = False;
        DBIc_set(dbh, DBIcf_AutoCommit, False);
        SvREFCNT_dec(dbh->database);
        dbh->database = 0;
        break;
    default:
        if (dbh->is_modeansi)
            dbh->is_txactive = True;
        /* COMMIT WORK for MODE ANSI databases when AutoCommit is On */
        if (dbh->is_modeansi == True && DBI_AutoCommit(dbh) == True)
        {
            dbd_ix_debug(1, "%s - AUTOCOMMIT On => COMMIT WORK\n", function);
            rc = dbd_ix_commit(dbh);
        }
        break;
    }

    DBIc_on(imp_sth, DBIcf_IMPSET); /* Qu'est que c'est? */
    dbd_ix_exit(function);
    return rc;
}

/*
** Execute the statement.
** - OPEN the cursor for a SELECT or cursory EXECUTE PROCEDURE.
** - EXECUTE the statement for anything else.
** Remember that dbd_st_execute() must return:
**      -2 or smaller   => error
**      -1              => unknown number of rows affected
**       0 or greater   => known number of rows affected
** DBD::Informix will not return -1, though there's at least half an
** argument for returning -1 after dbd_ix_open() is called.
*/
int
dbd_ix_st_execute(SV *sth, imp_sth_t *imp_sth)
{
    static const char function[] = "dbd_ix_st_execute";
    dTHR;
    int rv;
    int rc;

    dbd_ix_enter(function);

    if ((rc = dbd_db_setconnection(imp_sth->dbh)) == 0)
    {
        dbd_ix_savesqlca(imp_sth->dbh);
        assert(sqlca.sqlcode < 0);
        dbd_ix_exit(function);
        return(sqlca.sqlcode);
    }

    if (imp_sth->st_type == SQ_SELECT)
        rc = dbd_ix_open(imp_sth);
#ifdef SQ_EXECPROC
    else if (imp_sth->st_type == SQ_EXECPROC && imp_sth->n_ocols > 0)
        rc = dbd_ix_open(imp_sth);
#endif /* SQ_EXECPROC */
    else
    {
        rc = 1;
        /* only open cursor if it is not currently open, otherwise it flushes */
        if ((imp_sth->st_type == SQ_INSERT) &&
            (imp_sth->is_insertcursor == True) &&
            (imp_sth->st_state != Opened))
            rc = dbd_ix_open(imp_sth);
        if (rc)
            rc = dbd_ix_exec(imp_sth);
    }

    /* Map returned values from dbd_ix_exec and dbd_ix_open */
    if (rc == 0)
    {
        /* Statement failed -- return the error code */
        assert(sqlca.sqlcode < 0);
        rv = sqlca.sqlcode;
    }
    else
    {
        /**
        ** Statement succeeded.  Don't forget about MODE ANSI database and
        ** an UPDATE which does not alter any rows returning SQLNOTFOUND.
        ** MODE ANSI problem found by Chuck.Collins@zool.Airtouch.com
        */
        rv = sqlca.sqlerrd[2];
        assert((sqlca.sqlcode == 0 || sqlca.sqlcode == SQLNOTFOUND) && rv >= 0);
    }

    dbd_ix_exit(function);
    return(rv);
}

int
dbd_ix_st_rows(SV *sth, imp_sth_t *imp_sth)
{
    return(imp_sth->n_rows);
}

/*
** Map the DBI standard type numbers (SQL_NUMERIC, etc) to Informix types.
** Cribbed from DBD::Oracle v1.13, file dbdimp.c, function ora_sql_type().
*/
static int
ix_sql_type(int sql_type)
{
    int ix_type;

    /* XXX should detect DBI reserved standard type range here */

    switch (sql_type)
    {
    case SQL_NUMERIC:
    case SQL_DECIMAL:
    case SQL_INTEGER:
    case SQL_BIGINT:
    case SQL_TINYINT:
    case SQL_SMALLINT:
    case SQL_FLOAT:
    case SQL_REAL:
    case SQL_DOUBLE:
    case SQL_VARCHAR:
    case SQL_CHAR:
    case SQL_DATE:
    case SQL_TIME:



( run in 0.941 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )