/* vim: set noai ts=4 et sw=4: */
/*
Copyright (c) 2010, 2011 Popa Marius Adrian <mapopa@gmail.com>
Copyright (c) 2011 Damyan Ivanov <dmn@debian.org>
Copyright (c) 2010 pilcrow <mjp@pilcrow.madison.wi.us>
Copyright (c) 1999-2008 Edwin Pratomo
Portions Copyright (c) 2001-2005 Daniel Ritz
You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README file.
*/
#include "Firebird.h"
#include <stdint.h>
#include <inttypes.h>
DBISTATE_DECLARE;
#define IB_SQLtimeformat(xxh, format, sv) \
do { \
STRLEN len; \
char *frmt = NULL; \
char *buf = SvPV(sv, len); \
if (len < 2 || len > 30) break; \
Newx(frmt, len + 1, char); \
strcpy(frmt, buf); \
if (format) Safefree(format); \
format = frmt; \
} while (0)
#define IB_alloc_sqlda(sqlda, n) \
do { \
short len = n; \
char *tmp; \
if (sqlda) \
{ \
Safefree(sqlda); \
sqlda = NULL; \
} \
Newxz(tmp, XSQLDA_LENGTH(len), char); \
sqlda = (XSQLDA*)tmp; \
sqlda->sqln = len; \
sqlda->version = SQLDA_OK_VERSION; \
} while (0)
#ifndef is_ascii_string
#warning "Using built-in implementation of is_ascii_string."
#warning "Upgrading perl to 5.12 is suggested."
// for perl before 5.12.0 RC1
// taken straight from the perl source
bool is_ascii_string(const U8 *s, STRLEN len) {
const U8* const send = s + (len ? len : strlen((const char *)s));
const U8* x = s;
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];
Newxz(imp_sth->cursor_name, 22, char);
sprintf(imp_sth->cursor_name, "perl%16.16"PRIx32, (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;
else
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);
if (!is_ascii_string(p, len)
&& is_utf8_string(p, len)) {
SvUTF8_on(sv);
}
}
}
void dbd_init(dbistate_t *dbistate)
{
DBISTATE_INIT;
}
void ib_cleanup_st_prepare (imp_sth_t *imp_sth)
{
FREE_SETNULL(imp_sth->in_sqlda);
FREE_SETNULL(imp_sth->out_sqlda);
FREE_SETNULL(imp_sth->dateformat);
FREE_SETNULL(imp_sth->timeformat);
FREE_SETNULL(imp_sth->timestampformat);
}
void ib_cleanup_st_execute (imp_sth_t *imp_sth)
{
if (imp_sth->in_sqlda)
{
int i;
XSQLVAR *var = imp_sth->in_sqlda->sqlvar;
for (i = 0; i < imp_sth->in_sqlda->sqln; i++, var++)
{
Safefree(var->sqldata);
var->sqldata = NULL;
if (var->sqlind)
*(var->sqlind) = -1; /* isNULL */
}
}
}
/* lower level error handling */
void do_error(SV *h, int rc, char *what)
{
D_imp_xxh(h);
SV *errstr = DBIc_ERRSTR(imp_xxh);
sv_setiv(DBIc_ERR(imp_xxh), (IV)rc);
sv_setpv(errstr, what);
if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
PerlIO_printf(DBIc_LOGPIO(imp_xxh), "%s error %d recorded: %s\n",
what, rc, SvPV(errstr,PL_na));
}
#define CALC_AVAILABLE(buff) sizeof(buff) - strlen(buff) - 1
/*
decode status vector into a char pointer (implemented by a mortal scalar)
Returns NULL if there is no error
*/
char* ib_error_decode(const ISC_STATUS *status) {
if (status[0] == 1 && status[1] > 0)
{
SV *sv = NULL;
long sqlcode;
#if !defined(FB_API_VER) || FB_API_VER < 20
ISC_STATUS *pvector = status;
#else
const ISC_STATUS *pvector = status;
#endif
#if defined (INCLUDE_TYPES_PUB_H)
ISC_SCHAR msg[1024];
#else
char msg[1024];
#endif
if ((sqlcode = isc_sqlcode(status)) != 0)
{
isc_sql_interprete((short) sqlcode, msg, sizeof(msg));
sv = sv_2mortal(newSVpv(msg, 0));
}
#if !defined(FB_API_VER) || FB_API_VER < 20
while (isc_interprete(msg, &pvector))
#else
while (fb_interpret(msg, sizeof(msg), &pvector))
#endif
{
if ( sv != NULL ) {
sv_catpvn(sv, "\n-", 2);
sv_catpv(sv, msg);
}
else sv = sv_2mortal(newSVpv(msg,0));
}
sv_catpvn(sv, "\0", 1); // NUL-terminate
return SvPV_nolen(sv);
}
else return NULL;
}
/* higher level error handling, check and decode status */
int ib_error_check(SV *h, ISC_STATUS *status)
{
char *msg = ib_error_decode(status);
if (msg != NULL)
{
do_error(h, isc_sqlcode(status), msg);
return FAILURE;
}
else return SUCCESS;
}
static int ib2sql_type(int ibtype)
{
/* Firebird Internal (not external) types */
switch(ibtype)
{
case SQL_TEXT:
case 453:
return DBI_SQL_CHAR;
case SQL_LONG:
case 497:
return DBI_SQL_INTEGER; /* integer */
case SQL_SHORT:
case 501:
return DBI_SQL_SMALLINT; /* smallint */
case SQL_FLOAT:
case 483:
return DBI_SQL_FLOAT;
case SQL_DOUBLE:
case 481:
return DBI_SQL_DOUBLE;
case SQL_TIMESTAMP:
case 511:
return DBI_SQL_TIMESTAMP;
case SQL_TYPE_DATE:
case 571:
return DBI_SQL_DATE;
case SQL_TYPE_TIME:
case 561:
return DBI_SQL_TIME;
case SQL_VARYING:
case 449:
return DBI_SQL_VARCHAR;
}
/* else map type into DBI reserved standard range */
return -9000 - ibtype;
}
#if 0
/* from DBI (ANSI/ISO/ODBC) types to Firebird types */
static int ib_sql_type(imp_sth_t *imp_sth, char *name, int sql_type)
{
/* XXX should detect DBI reserved standard type range here */
switch (sql_type) {
case DBI_SQL_NUMERIC:
case DBI_SQL_DECIMAL:
case DBI_SQL_INTEGER:
case DBI_SQL_BIGINT:
case DBI_SQL_TINYINT:
case DBI_SQL_SMALLINT:
case DBI_SQL_FLOAT:
case DBI_SQL_REAL:
case DBI_SQL_DOUBLE:
return 481;
case DBI_SQL_VARCHAR:
return 449;
case DBI_SQL_CHAR:
return 453;
case SQL_DATE:
case SQL_TIME:
case SQL_TIMESTAMP:
default:
if (DBIc_WARN(imp_sth) && imp_sth && name)
warn("SQL type %d for '%s' is not fully supported, bound as SQL_VARCHAR instead");
return ib_sql_type(imp_sth, name, DBI_SQL_VARCHAR);
}
}
#endif
int dbd_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid,
char *pwd, SV *attr)
{
dTHR;
ISC_STATUS status[ISC_STATUS_LENGTH];
HV *hv;
SV *sv;
SV **svp; /* versatile scalar storage */
unsigned short ib_dialect, ib_cache;
char *ib_role;
char ISC_FAR *dpb_buffer, *dpb;
char ISC_FAR *database;
STRLEN len, db_len; /* for SvPV */
char dbkey_scope = 0;
short dpb_length = 0;
unsigned int buflen = 0; /* buffer size is dynamic */
imp_dbh->db = 0L;
imp_dbh->tr = 0L;
imp_dbh->tpb_buffer = NULL;
imp_dbh->tpb_length = 0;
imp_dbh->sth_ddl = 0;
imp_dbh->soft_commit = 0; /* use soft commit (isc_commit_retaining)? */
imp_dbh->ib_enable_utf8 = FALSE;
/* default date/time formats
+ *
* Old API: dateformat ........ %c
* timeformat ........ (none)
* timestampformat ... (none)
*
* v6 API: dateformat ........ %x
* timeformat ........ %X
* timestampformat ... %c
*/
Newxz(imp_dbh->dateformat, 3, char);
strcpy(imp_dbh->dateformat, "%x");
Newxz(imp_dbh->timeformat, 3, char);
strcpy(imp_dbh->timeformat, "%X");
Newxz(imp_dbh->timestampformat, 3, char);
strcpy(imp_dbh->timestampformat, "%c");
/* linked list */
imp_dbh->first_sth = NULL;
imp_dbh->last_sth = NULL;
/* save the current context for thread/multiplicy safety */
#if defined(USE_THREADS) || defined(USE_ITHREADS) || defined(MULTIPLICITY)
imp_dbh->context = PERL_GET_CONTEXT;
#endif
/* Parse DSN and init values */
sv = DBIc_IMP_DATA(imp_dbh);
if (!sv || !SvROK(sv))
return FALSE;
hv = (HV*) SvRV(sv);
if (SvTYPE(hv) != SVt_PVHV)
return FALSE;
if (uid != NULL) {
DPB_PREP_STRING(buflen, uid);
}
if (pwd != NULL) {
DPB_PREP_STRING(buflen, pwd);
}
/* does't go to DPB -> no buflen inc */
if ((svp = hv_fetch(hv, "database", 8, FALSE)))
database = SvPV(*svp, db_len);
else database = NULL;
/* role, cache, charset, sqldialect */
if ((svp = hv_fetch(hv, "ib_dialect", 10, FALSE)))
ib_dialect = (unsigned short) SvIV(*svp);
else
ib_dialect = DEFAULT_SQL_DIALECT;
DPB_PREP_INTEGER(buflen);
if ((svp = hv_fetch(hv, "ib_cache", 8, FALSE)))
{
ib_cache = (unsigned short) SvIV(*svp);
DPB_PREP_INTEGER(buflen);
}
else
ib_cache = 0;
if ((svp = hv_fetch(hv, "ib_charset", 10, FALSE)))
{
char *p = SvPV(*svp, len);
DPB_PREP_STRING_LEN(buflen, len);
Newx(imp_dbh->ib_charset, len+1, char);
strncpy(imp_dbh->ib_charset, p, len);
*(imp_dbh->ib_charset + len) = '\0';
}
else {
imp_dbh->ib_charset = NULL;
}
if ((svp = hv_fetch(hv, "ib_role", 7, FALSE)))
{
ib_role = SvPV(*svp, len);
DPB_PREP_STRING_LEN(buflen, len);
}
else
ib_role = NULL;
if ((svp = hv_fetch(hv, "ib_dbkey_scope", 14, FALSE)))
{
dbkey_scope = (char)SvIV(*svp);
if (dbkey_scope)
DPB_PREP_INTEGER(buflen);
}
/* add length of other parameters to needed buflen */
buflen += 1; /* dbpversion */
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_db_login6\n"));
/* Allocate DPB */
Newx(dpb_buffer, buflen, char);
/* Default SQL dialect for every statement */
imp_dbh->sqldialect = ib_dialect;
/* Fill DPB */
dpb = dpb_buffer;
*dpb++ = isc_dpb_version1;
DPB_FILL_STRING(dpb, isc_dpb_user_name, uid);
DPB_FILL_STRING(dpb, isc_dpb_password, pwd);
if (ib_cache)
{
/*
* Safety check: Do not allocate a cache buffer greater than
* 10000 pages, so we don't exhaust memory inadvertently.
*/
if (ib_cache > 10000) ib_cache = 10000;
DPB_FILL_INTEGER(dpb, isc_dpb_num_buffers, ib_cache);
}
DPB_FILL_INTEGER(dpb, isc_dpb_sql_dialect, ib_dialect);
if (dbkey_scope)
{
DPB_FILL_INTEGER(dpb, isc_dpb_dbkey_scope, dbkey_scope);
}
if (imp_dbh->ib_charset)
{
DPB_FILL_STRING(dpb, isc_dpb_lc_ctype, imp_dbh->ib_charset);
}
if (ib_role)
{
DPB_FILL_STRING(dpb, isc_dpb_sql_role_name, ib_role);
}
dpb_length = dpb - dpb_buffer;
if ( dpb_length != buflen ) {
fprintf(stderr, "# db_login6: %d != %d\n", dpb_length, buflen);
fflush(stderr);
abort();
}
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_login6: attaching to database %s..\n", database));
isc_attach_database(status, /* status vector */
db_len,
database, /* connect string */
&(imp_dbh->db), /* ref to db handle */
dpb_length, /* length of dpb */
dpb_buffer); /* connect options */
/* freeing database parameter buffer */
Safefree(dpb_buffer);
/* return false on failed attach */
if (ib_error_check(dbh, status))
return FALSE;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_login6: success attaching.\n"));
/* Tell DBI, that dbh->destroy should be called for this handle */
DBIc_IMPSET_on(imp_dbh);
/* Tell DBI, that dbh->disconnect should be called for this handle */
DBIc_ACTIVE_on(imp_dbh);
return TRUE;
}
int dbd_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid,
char *pwd)
{
return dbd_db_login6(dbh, imp_dbh, dbname, uid, pwd, Nullsv);
}
int dbd_db_ping(SV *dbh)
{
D_imp_dbh(dbh);
ISC_STATUS status[ISC_STATUS_LENGTH];
char buffer[100];
char req[] = {
isc_info_ods_version,
isc_info_end
};
DBI_TRACE_imp_xxh(imp_dbh, 1, (DBIc_LOGPIO(imp_dbh), "dbd_db_ping\n"));
if (isc_database_info(status, &(imp_dbh->db), sizeof(req), req, sizeof(buffer), buffer))
if (ib_error_check(dbh, status))
return FALSE;
return TRUE;
}
int dbd_db_disconnect(SV *dbh, imp_dbh_t *imp_dbh)
{
dTHR;
ISC_STATUS status[ISC_STATUS_LENGTH];
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_db_disconnect\n"));
/* set the database handle to inactive */
DBIc_ACTIVE_off(imp_dbh);
/* always do a rollback if there's an open transaction.
* Firebird requires to close open transactions before
* detaching a database.
*/
if (imp_dbh->tr)
{
/* rollback and close trans context */
isc_rollback_transaction(status, &(imp_dbh->tr));
if (ib_error_check(dbh, status))
return FALSE;
imp_dbh->tr = 0L;
}
FREE_SETNULL(imp_dbh->ib_charset);
FREE_SETNULL(imp_dbh->tpb_buffer);
FREE_SETNULL(imp_dbh->dateformat);
FREE_SETNULL(imp_dbh->timeformat);
FREE_SETNULL(imp_dbh->timestampformat);
/* detach database */
isc_detach_database(status, &(imp_dbh->db));
if (ib_error_check(dbh, status))
return FALSE;
return TRUE;
}
void dbd_db_destroy (SV *dbh, imp_dbh_t *imp_dbh)
{
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_db_destroy\n"));
if (DBIc_ACTIVE(imp_dbh))
dbd_db_disconnect(dbh, imp_dbh);
/* Nothing in imp_dbh to be freed */
DBIc_IMPSET_off(imp_dbh);
}
int dbd_db_commit (SV *dbh, imp_dbh_t *imp_dbh)
{
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_db_commit\n"));
/* no commit if AutoCommit on */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit))
return FALSE;
/* commit the transaction */
if (!ib_commit_transaction(dbh, imp_dbh))
return FALSE;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_commit succeed.\n"));
return TRUE;
}
int dbd_db_rollback(SV *dbh, imp_dbh_t *imp_dbh)
{
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_db_rollback\n"));
/* no rollback if AutoCommit = on */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE)
return FALSE;
/* rollback the transaction */
if (!ib_rollback_transaction(dbh, imp_dbh))
return FALSE;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_rollback succeed.\n"));
return TRUE;
}
int dbd_db_STORE_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)
{
STRLEN kl;
char *key = SvPV(keysv, kl);
int on = SvTRUE(valuesv)? 1: 0;
int oldval;
int set_frmts = 0;
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_db_STORE - %s\n", key));
/**************************************************************************/
if ((kl==10) && strEQ(key, "AutoCommit"))
{
oldval = DBIc_has(imp_dbh, DBIcf_AutoCommit)? 1: 0;
DBIc_set(imp_dbh, DBIcf_AutoCommit, on);
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_STORE: switch AutoCommit from %d to %d\n", oldval, on));
if (oldval == FALSE && on)
{
/* AutoCommit set from 0 to 1, commit any outstanding changes */
if (imp_dbh->tr)
{
if (!ib_commit_transaction(dbh, imp_dbh))
return FALSE;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_STORE: commit open transaction\n"));
}
}
return TRUE; /* handled */
}
/**************************************************************************/
else if ((kl==13) && strEQ(key, "ib_softcommit"))
{
oldval = imp_dbh->soft_commit;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_STORE: switch ib_softcommit from %d to %d\n", oldval, on));
/* set new value */
imp_dbh->soft_commit = on;
/* switching softcommit from 1 to 0 -> make a hard commit */
if (!on && oldval)
{
if (imp_dbh->tr)
{
if (!ib_commit_transaction(dbh, imp_dbh))
return FALSE;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_db_STORE: commit open transaction\n"));
}
}
return TRUE; /* handled */
}
else if ((kl==14) && strEQ(key, "ib_enable_utf8")) {
if (on) {
if (imp_dbh->ib_charset && strEQ(imp_dbh->ib_charset, "UTF8")) {
imp_dbh->ib_enable_utf8 = TRUE;
return TRUE;
}
else croak( "ib_enable_utf8 requires ib_charset=UTF8 in DSN (you gave %s)", imp_dbh->ib_charset ? imp_dbh->ib_charset : "<nothing>" );
}
else {
imp_dbh->ib_enable_utf8 = FALSE;
return TRUE;
}
}
else if ((kl==11) && strEQ(key, "ib_time_all"))
set_frmts = 1;
/**************************************************************************/
if (set_frmts || ((kl==13) && strEQ(key, "ib_dateformat")))
{
IB_SQLtimeformat(dbh, imp_dbh->dateformat, valuesv);
if (!set_frmts) return TRUE;
}
if (set_frmts || ((kl==13) && strEQ(key, "ib_timeformat")))
{
IB_SQLtimeformat(dbh, imp_dbh->timeformat, valuesv);
if (!set_frmts) return TRUE;
}
if (set_frmts || ((kl==18) && strEQ(key, "ib_timestampformat")))
{
IB_SQLtimeformat(dbh, imp_dbh->timestampformat, valuesv);
if (!set_frmts) return TRUE;
}
/**************************************************************************/
if (set_frmts) return TRUE;
else return FALSE; /* not handled */
}
SV *dbd_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)
{
STRLEN kl;
char * key = SvPV(keysv, kl);
SV * result = NULL;
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "dbd_db_FETCH - %s\n", key));
if ((kl==10) && strEQ(key, "AutoCommit"))
result = boolSV(DBIc_has(imp_dbh, DBIcf_AutoCommit));
else if ((kl==13) && strEQ(key, "ib_softcommit"))
result = boolSV(imp_dbh->soft_commit);
else if ((kl==14) && strEQ(key, "ib_enable_utf8"))
result = boolSV(imp_dbh->ib_enable_utf8);
else if ((kl==13) && strEQ(key, "ib_dateformat"))
result = newSVpvn(imp_dbh->dateformat, strlen(imp_dbh->dateformat));
else if ((kl==13) && strEQ(key, "ib_timeformat"))
result = newSVpvn(imp_dbh->timeformat, strlen(imp_dbh->timeformat));
else if ((kl==18) && strEQ(key, "ib_timestampformat"))
result = newSVpvn(imp_dbh->timestampformat,
strlen(imp_dbh->timestampformat));
else if ((kl==11) && strEQ(key, "ib_embedded"))
#ifdef EMBEDDED
result = &PL_sv_yes;
#else
result = &PL_sv_no;
#endif
if (result == NULL)
return Nullsv;
else
{
if ((result == &PL_sv_yes) || (result == &PL_sv_no))
return result;
else
return sv_2mortal(result);
}
}
void dbd_preparse(SV *sth, imp_sth_t *imp_sth, char *statement)
{
ISC_STATUS status[ISC_STATUS_LENGTH];
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "Enter dbd_preparse\n"));
isc_dsql_describe_bind(status, &(imp_sth->stmt), 1, imp_sth->in_sqlda);
if (ib_error_check(sth, status))
{
ib_cleanup_st_prepare(imp_sth);
return;
}
/* realloc in_sqlda and rebind if not enough XSQLVAR for bind params */
if (imp_sth->in_sqlda->sqld > imp_sth->in_sqlda->sqln)
{
IB_alloc_sqlda(imp_sth->in_sqlda, imp_sth->in_sqlda->sqld);
if (imp_sth->in_sqlda == NULL)
{
do_error(sth, 1, "Fail to reallocate in_slqda");
ib_cleanup_st_prepare(imp_sth);
return;
}
else
{
isc_dsql_describe_bind(status, &(imp_sth->stmt), 1, imp_sth->in_sqlda);
if (ib_error_check(sth, status))
{
ib_cleanup_st_prepare(imp_sth);
return;
}
}
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_preparse: describe_bind passed.\n"
"dbd_preparse: exit; in_sqlda: sqld: %d, sqln: %d.\n",
imp_sth->in_sqlda->sqld, imp_sth->in_sqlda->sqln));
DBIc_NUM_PARAMS(imp_sth) = imp_sth->in_sqlda->sqld;
}
int dbd_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs)
{
D_imp_dbh_from_sth;
ISC_STATUS status[ISC_STATUS_LENGTH];
int i;
short dtype;
static char stmt_info[1];
char info_buffer[20], count_item;
XSQLVAR *var;
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "Enter dbd_st_prepare\n"));
if (!DBIc_ACTIVE(imp_dbh))
{
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)
{
SV **svp;
if ((svp = DBD_ATTRIB_GET_SVP(attribs, "ib_time_all", 11)) != NULL)
{
IB_SQLtimeformat(sth, imp_sth->dateformat, *svp);
IB_SQLtimeformat(sth, imp_sth->timestampformat, *svp);
IB_SQLtimeformat(sth, imp_sth->timeformat, *svp);
}
if ((svp = DBD_ATTRIB_GET_SVP(attribs, "ib_dateformat", 13)) != NULL)
IB_SQLtimeformat(sth, imp_sth->dateformat, *svp);
if ((svp = DBD_ATTRIB_GET_SVP(attribs, "ib_timestampformat", 18)) != NULL)
IB_SQLtimeformat(sth, imp_sth->timestampformat, *svp);
if ((svp = DBD_ATTRIB_GET_SVP(attribs, "ib_timeformat", 13)) != NULL)
IB_SQLtimeformat(sth, imp_sth->timeformat, *svp);
}
/* allocate 1 XSQLVAR to in_sqlda */
IB_alloc_sqlda(imp_sth->in_sqlda, 1);
if (imp_sth->in_sqlda == NULL)
{
do_error(sth, 2, "Fail to allocate in_sqlda");
return FALSE;
}
/* allocate 1 XSQLVAR to out_sqlda */
IB_alloc_sqlda(imp_sth->out_sqlda, 1);
if (imp_sth->out_sqlda == NULL)
{
do_error(sth, 2, "Fail to allocate out_sqlda");
ib_cleanup_st_prepare(imp_sth);
return FALSE;
}
/* init statement handle */
isc_dsql_alloc_statement2(status, &(imp_dbh->db), &(imp_sth->stmt));
if (ib_error_check(sth, status))
{
ib_cleanup_st_prepare(imp_sth);
return FALSE;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: sqldialect: %d.\n", imp_dbh->sqldialect));
if (!imp_dbh->tr)
{
/* start a new transaction using current TPB */
if (!ib_start_transaction(sth, imp_dbh))
{
ib_cleanup_st_prepare(imp_sth);
return FALSE;
}
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: statement: %s.\n", statement));
isc_dsql_prepare(status, &(imp_dbh->tr), &(imp_sth->stmt), 0, statement,
imp_dbh->sqldialect, imp_sth->out_sqlda);
if (ib_error_check(sth, status))
{
ib_cleanup_st_prepare(imp_sth);
return FALSE;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: isc_dsql_prepare succeed..\n"));
stmt_info[0] = isc_info_sql_stmt_type;
isc_dsql_sql_info(status, &(imp_sth->stmt), sizeof (stmt_info), stmt_info,
sizeof (info_buffer), info_buffer);
if (ib_error_check(sth, status))
{
ib_cleanup_st_prepare(imp_sth);
return FALSE;
}
{
short l = (short) isc_vax_integer((char *) info_buffer + 1, 2);
imp_sth->type = isc_vax_integer((char *) info_buffer + 3, l);
}
/* sanity check of statement type */
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: statement type: %ld.\n", imp_sth->type));
switch (imp_sth->type)
{
/* Implemented statement types. */
case isc_info_sql_stmt_select:
case isc_info_sql_stmt_select_for_upd:
/*
* Unfortunately, select count item doesn't work
* in current versions of Firebird.
* isql does it literally by fetching everything
* and counting the number of rows it fetched.
* Firebird doesn't seem to be able to estimate
* the number of rows before the client app
* fetches them all.
*/
//count_item = isc_info_req_select_count;
break;
case isc_info_sql_stmt_insert:
count_item = isc_info_req_insert_count;
break;
case isc_info_sql_stmt_update:
count_item = isc_info_req_update_count;
break;
case isc_info_sql_stmt_delete:
count_item = isc_info_req_delete_count;
break;
case isc_info_sql_stmt_ddl:
case isc_info_sql_stmt_set_generator:
case isc_info_sql_stmt_exec_procedure:
/* no count_item to gather */
break;
/*
* Unimplemented statement types. Some may be implemented in the future.
*/
case isc_info_sql_stmt_get_segment:
case isc_info_sql_stmt_put_segment:
case isc_info_sql_stmt_start_trans:
case isc_info_sql_stmt_commit:
case isc_info_sql_stmt_rollback:
default:
do_error(sth, 10, "Statement type is not implemented in this version of DBD::Firebird");
return FALSE;
break;
}
imp_sth->count_item = count_item;
/* scan statement for '?', ':1' and/or ':foo' style placeholders */
/* realloc in_sqlda where needed */
dbd_preparse(sth, imp_sth, statement);
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: dbd_describe passed.\n"
"out_sqlda: sqld: %d, sqln: %d.\n",
imp_sth->out_sqlda->sqld, imp_sth->out_sqlda->sqln));
/* enough output parameter block ? */
if (imp_sth->out_sqlda->sqld > imp_sth->out_sqlda->sqln)
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: realloc out_sqlda..\n"));
IB_alloc_sqlda(imp_sth->out_sqlda, imp_sth->out_sqlda->sqld);
if (imp_sth->out_sqlda == NULL)
{
do_error(sth, IB_ALLOC_FAIL, "Fail to reallocate out_sqlda");
ib_cleanup_st_prepare(imp_sth);
return FALSE;
}
else
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: calling isc_dsql_describe again..\n"));
isc_dsql_describe(status, &(imp_sth->stmt), 1, imp_sth->out_sqlda);
if (ib_error_check(sth, status))
{
ib_cleanup_st_prepare(imp_sth);
return FALSE;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: success calling isc_dsql_describe.\n"));
}
}
else if (imp_sth->out_sqlda->sqld == 0) /* not a select statement */
{
Safefree(imp_sth->out_sqlda);
imp_sth->out_sqlda = NULL;
}
if (imp_sth->out_sqlda)
{
for (i = 0, var = imp_sth->out_sqlda->sqlvar;
i < imp_sth->out_sqlda->sqld;
i++, var++)
{
dtype = (var->sqltype & ~1);
var->sqlind = NULL;
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: field type: %d.\n", dtype));
/* Alloc space for sqldata */
Newx(var->sqldata,
var->sqllen + (dtype == SQL_VARYING ? sizeof(short) : 0),
ISC_SCHAR);
/* Nullable? */
if (var->sqltype & 1)
Newx(var->sqlind, 1, short);
}
}
/* statment is valid -> insert into linked list (at begin) */
imp_sth->next_sth = imp_dbh->first_sth;
if (imp_dbh->first_sth == NULL)
imp_dbh->last_sth = imp_sth;
else
imp_dbh->first_sth->prev_sth = imp_sth;
imp_dbh->first_sth = imp_sth;
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_prepare: sth inserted into linked list.\n"));
/* tell DBI that we have a real statement handle now */
DBIc_IMPSET_on(imp_sth);
return TRUE;
}
int dbd_st_execute(SV *sth, imp_sth_t *imp_sth)
{
D_imp_dbh_from_sth;
ISC_STATUS status[ISC_STATUS_LENGTH];
int result = -2;
int row_count = 0;
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "dbd_st_execute\n"));
/* if not already done: start new transaction */
if (!imp_dbh->tr)
if (!ib_start_transaction(sth, imp_dbh))
return result;
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: statement type: %ld.\n", imp_sth->type));
/* we count DDL statments */
if (imp_sth->type == isc_info_sql_stmt_ddl)
imp_dbh->sth_ddl++;
/* exec procedure statement */
if (imp_sth->type == isc_info_sql_stmt_exec_procedure)
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: calling isc_dsql_execute2 (exec procedure)..\n"));
isc_dsql_execute2(status, &(imp_dbh->tr), &(imp_sth->stmt),
imp_dbh->sqldialect,
(imp_sth->in_sqlda && (imp_sth->in_sqlda->sqld > 0))?
imp_sth->in_sqlda: NULL,
(imp_sth->out_sqlda && (imp_sth->out_sqlda->sqld > 0))?
imp_sth->out_sqlda: NULL);
if (ib_error_check(sth, status))
{
ib_cleanup_st_execute(imp_sth);
return result;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: isc_dsql_execute2 succeed.\n"));
result = row_count = imp_sth->affected = 0;
}
else /* all other types of SQL statements */
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: calling isc_dsql_execute..\n"));
/* check for valid in_sqlda */
if (!imp_sth->in_sqlda)
return FALSE;
isc_dsql_execute(status, &(imp_dbh->tr), &(imp_sth->stmt),
imp_dbh->sqldialect,
imp_sth->in_sqlda->sqld > 0 ? imp_sth->in_sqlda: NULL);
if (ib_error_check(sth, status))
{
ib_cleanup_st_execute(imp_sth);
/* rollback any active transaction */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit) && imp_dbh->tr)
ib_commit_transaction(sth, imp_dbh);
return result;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: isc_dsql_execute succeed.\n"));
}
if (imp_sth->count_item)
{
//PerlIO_printf(PerlIO_stderr(), "calculating row count\n");
row_count = ib_rows(sth, &(imp_sth->stmt), imp_sth->count_item);
if (row_count <= -2)
ib_cleanup_st_execute(imp_sth);
else
result = imp_sth->affected = row_count;
}
else if (imp_sth->type == isc_info_sql_stmt_select)
result = row_count = imp_sth->affected = 0;
else
result = -1;
/* Jika AutoCommit On, commit_transaction() (bukan retaining),
* dan reset imp_dbh->tr == 0L
* For SELECT statement, commit_transaction() is called after fetch,
* or within finish()
*/
if (DBIc_has(imp_dbh, DBIcf_AutoCommit)
&& imp_sth->type != isc_info_sql_stmt_select
&& imp_sth->type != isc_info_sql_stmt_select_for_upd
&& imp_sth->type != isc_info_sql_stmt_exec_procedure)
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: calling ib_commit_transaction..\n"));
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:
case isc_info_sql_stmt_select_for_upd:
case isc_info_sql_stmt_exec_procedure:
DBIc_NUM_FIELDS(imp_sth) = (imp_sth->out_sqlda)?
imp_sth->out_sqlda->sqld: 0;
DBIc_ACTIVE_on(imp_sth);
break;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_execute: row count: %d.\n"
"dbd_st_execute: count_item: %d.\n",
row_count, imp_sth->count_item));
return result;
}
/* from out_sqlda to AV */
AV *dbd_st_fetch(SV *sth, imp_sth_t *imp_sth)
{
D_imp_dbh_from_sth; /* declare imp_dbh from sth */
ISC_STATUS fetch = 0;
ISC_STATUS status[ISC_STATUS_LENGTH];
int chopBlanks; /* chopBlanks ? */
AV *av; /* array buffer */
SV *sv, **svp; /* buffers */
XSQLVAR *var; /* working pointer XSQLVAR */
int i; /* loop */
short dtype;
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "dbd_st_fetch\n"));
if (!DBIc_ACTIVE(imp_sth))
{
do_error(sth, 0, "no statement executing (perhaps you need to call execute first)\n");
return Nullav;
}
chopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
av = DBIS->get_fbav(imp_sth);
svp = AvARRAY(av);
/*
* if it's an execute procedure, we've already got the
* output from the isc_dsql_execute2() call in dbd_st_execute().
*/
if (imp_sth->type != isc_info_sql_stmt_exec_procedure)
{
fetch = isc_dsql_fetch(status, &(imp_sth->stmt), imp_dbh->sqldialect,
imp_sth->out_sqlda);
if (ib_error_check(sth, status))
return Nullav;
/*
* Code 100 means we've reached the end of the set
* of rows that the SELECT will return.
*/
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "dbd_st_fetch: fetch result: %"PRIdPTR"\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? */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit))
{
if (!ib_commit_transaction(sth, imp_dbh))
return Nullav;
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "fetch ends: ib_commit_transaction succeed.\n"));
}
return Nullav;
}
else if (fetch != 0) /* something bad */
{ do_error(sth, 0, "Fetch error");
DBIc_ACTIVE_off(imp_sth);
return Nullav;
}
} /* !exec_procedure */
else
{
/* we only fetch one row for exec procedure */
if (imp_sth->affected)
return Nullav;
}
var = imp_sth->out_sqlda->sqlvar;
for (i = 0; i < imp_sth->out_sqlda->sqld; i++, var++)
{
sv = svp[i];
dtype = var->sqltype & ~1;
if ((var->sqltype & 1) && (*(var->sqlind) == -1))
/* if nullable field */
{
/* isNULL */
SvOK_off(sv);
}
else
{
/*
* Got a non-null field. Got to pass it back to the
* application, which means some datatype dependant code.
*/
switch (dtype)
{
case SQL_SHORT:
if (var->sqlscale) /* handle NUMERICs */
{
double numeric;
numeric = ((double) (*(short *) var->sqldata)) /
pow(10.0, (double) -var->sqlscale);
sv_setnv(sv, numeric);
}
else
sv_setiv(sv, *(short *) (var->sqldata));
break;
case SQL_LONG:
if (var->sqlscale) /* handle NUMERICs */
{
double numeric;
numeric = ((double) (*(ISC_LONG *) var->sqldata)) /
pow(10.0, (double) -var->sqlscale);
sv_setnv(sv, numeric);
}
else
sv_setiv(sv, *(ISC_LONG *) (var->sqldata));
break;
#ifdef SQL_INT64
case SQL_INT64:
/*
* This seemed difficult at first to return
* a 64-bit scaled numeric to Perl through the
* SV interface. But as luck would have it,
* Perl treats strings and numerics identically.
* I can return this numeric as a string and
* nobody has a problem with it.
*/
{
static ISC_INT64 const scales[] = { 1LL,
10LL,
100LL,
1000LL,
10000LL,
100000LL,
1000000LL,
10000000LL,
100000000LL,
1000000000LL,
10000000000LL,
100000000000LL,
1000000000000LL,
10000000000000LL,
100000000000000LL,
1000000000000000LL,
10000000000000000LL,
100000000000000000LL };
ISC_INT64 i; /* significand */
char buf[22]; /* NUMERIC(18,2) = -92233720368547758.08 + '\0' */
i = *((ISC_INT64 *) (var->sqldata));
/* We use the system snprintf(3) and system-specific
* format codes. :( On my perl, I was unable to
* persuade sv_setpvf to handle INT64 values with
* IVdf (and there is no I64f).
* - MJP 2010-03-25
*/
#if defined(_MSC_VER) /* Microsoft C compiler/library */
# define DBD_IB_INT64f "I64d"
#elif defined (__FreeBSD__) /* FreeBSD */
# define DBD_IB_INT64f "qd"
#else /* others: linux, various unices */
# define DBD_IB_INT64f "lld"
#endif
if (var->sqlscale == 0) {
snprintf(buf, sizeof(buf), "%"DBD_IB_INT64f, i);
} else {
ISC_INT64 divisor, remainder;
divisor = scales[-var->sqlscale];
remainder = (i%divisor);
if (remainder < 0) remainder = -remainder;
snprintf(buf, sizeof(buf),
"%"DBD_IB_INT64f".%0*"DBD_IB_INT64f,
i/divisor, -var->sqlscale, remainder);
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "-------------->SQLINT64=%"DBD_IB_INT64f".%0*"DBD_IB_INT64f,i/divisor, -var->sqlscale, remainder ));
}
sv_setpvn(sv, buf, strlen(buf));
}
break;
#endif
case SQL_FLOAT:
sv_setnv(sv, (double)(*(float *) (var->sqldata)));
break;
case SQL_DOUBLE:
if (var->sqlscale) /* handle NUMERICs */
{
double d = *(double *)var->sqldata;
short q = -var->sqlscale;
sv_setnv(sv, d > 0?
floor(d * pow(10.0, (double) q)) /
pow(10.0, (double) q):
ceil(d * pow(10.0, (double) q)) /
pow(10.0, (double) q));
}
else
sv_setnv(sv, *(double *) (var->sqldata));
break;
case SQL_TEXT:
/*
* Thanks to DAM for pointing out that I
* don't need to null-terminate this
* buffer, and in fact it's a buffer
* overrun if I do!
*/
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "Fill in TEXT type..\nLength: %d\n", var->sqllen));
if (chopBlanks && (var->sqllen > 0))
{
short len = var->sqllen;
char *p = (char*)(var->sqldata);
while (len && (p[len-1] == ' ')) len--;
sv_setpvn(sv, p, len);
}
else
sv_setpvn(sv, var->sqldata, var->sqllen);
maybe_upgrade_to_utf8(imp_dbh, sv);
break;
case SQL_VARYING:
{
DBD_VARY *vary = (DBD_VARY *) var->sqldata;
sv_setpvn(sv, vary->vary_string, vary->vary_length);
/* Note that sqllen for VARCHARs is the max length */
maybe_upgrade_to_utf8(imp_dbh, sv);
break;
}
/*
* If user specifies a TimestampFormat, TimeFormat, or
* DateFormat property of the Statement class, then that
* string is the format string for strftime().
*
* If the user doesn't specify an XxxFormat, then format
* is %c, defined in /usr/lib/locale/<locale>/LC_TIME/time,
* where <locale> is the host's chosen locale.
*/
case SQL_TIMESTAMP:
case SQL_TYPE_DATE:
case SQL_TYPE_TIME:
{
char *format = NULL, buf[100];
struct tm times;
long int fpsec = 0;
switch (dtype)
{
case SQL_TIMESTAMP:
isc_decode_timestamp((ISC_TIMESTAMP *) var->sqldata, ×);
format = imp_sth->timestampformat ?
imp_sth->timestampformat :
imp_dbh->timestampformat;
fpsec = TIMESTAMP_FPSECS(var->sqldata);
break;
case SQL_TYPE_DATE:
isc_decode_sql_date((ISC_DATE *) var->sqldata, ×);
format = imp_sth->dateformat ?
imp_sth->dateformat :
imp_dbh->dateformat;
break;
case SQL_TYPE_TIME:
isc_decode_sql_time((ISC_TIME *) var->sqldata, ×);
format = imp_sth->timeformat ?
imp_sth->timeformat :
imp_dbh->timeformat;
fpsec = TIME_FPSECS(var->sqldata);
break;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "Decode passed.\n"));
/* hardcoded output format.... */
if (strEQ(format, "iso") || strEQ(format, "ISO"))
{
switch (dtype)
{
case SQL_TIMESTAMP:
sprintf(buf, "%04d-%02d-%02d %02d:%02d:%02d.%04ld",
times.tm_year + 1900,
times.tm_mon + 1,
times.tm_mday,
times.tm_hour,
times.tm_min,
times.tm_sec,
fpsec);
break;
case SQL_TYPE_DATE:
sprintf(buf, "%04d-%02d-%02d",
times.tm_year + 1900,
times.tm_mon + 1,
times.tm_mday);
break;
case SQL_TYPE_TIME:
sprintf(buf, "%02d:%02d:%02d.%04ld",
times.tm_hour,
times.tm_min,
times.tm_sec,
fpsec);
break;
}
sv_setpvn(sv, buf, strlen(buf));
break;
}
/* output as array like perl's localtime? */
if (strEQ(format, "tm") || strEQ(format, "TM"))
{
AV *list = newAV();
av_push(list, newSViv(times.tm_sec));
av_push(list, newSViv(times.tm_min));
av_push(list, newSViv(times.tm_hour));
av_push(list, newSViv(times.tm_mday));
av_push(list, newSViv(times.tm_mon));
av_push(list, newSViv(times.tm_year));
av_push(list, newSViv(times.tm_wday));
av_push(list, newSViv(times.tm_yday));
av_push(list, newSViv(times.tm_isdst));
/* value returned is a reference to the array */
sv_setsv(sv, sv_2mortal(newRV_noinc((SV *) list)));
break;
}
#ifndef WIN32
/*
* may be we must here copy additional fields needed on
* some platforms for some strftime formats. copy from a
* dummy struct passed to mktime(). calling mktime()
* directly with × is wrong.
*/
/* struct tm has 9 fields plus may be some more */
if (sizeof(struct tm) > (9*sizeof(int)))
{
struct tm dummy;
Zero(&dummy, 1, struct tm);
mktime(&dummy);
memcpy(((char *)×) + 9*sizeof(int),
((char *)&dummy) + 9*sizeof(int),
sizeof(struct tm) - (9*sizeof(int)));
}
#endif
strftime(buf, sizeof(buf), format, ×);
sv_setpvn(sv, buf, strlen(buf));
break;
}
case SQL_BLOB:
{
isc_blob_handle blob_handle = 0;
int blob_stat;
char blob_info_buffer[32], *p,
blob_segment_buffer[BLOB_SEGMENT];
char blob_info_items[] =
{
isc_info_blob_type,
isc_info_blob_max_segment,
isc_info_blob_total_length
};
long max_segment = -1L, total_length = -1L, t;
unsigned short seg_length;
unsigned short blob_type = -1;
/* Open the Blob according to the Blob id. */
isc_open_blob2(status, &(imp_dbh->db), &(imp_dbh->tr),
&blob_handle, (ISC_QUAD *) var->sqldata,
#if defined(INCLUDE_FB_TYPES_H) || defined(INCLUDE_TYPES_PUB_H)
(ISC_USHORT) 0,
(ISC_UCHAR) 0);
#else
(short) 0, /* no Blob filter */
(char *) NULL); /* no Blob filter */
#endif
if (ib_error_check(sth, status))
return FALSE;
/* query blob information to find out the segment size */
isc_blob_info(status, &blob_handle, sizeof(blob_info_items),
blob_info_items, sizeof(blob_info_buffer),
blob_info_buffer);
if (ib_error_check(sth, status))
{
isc_cancel_blob(status, &blob_handle);
return FALSE;
}
/* Get the information out of the info buffer. */
for (p = blob_info_buffer; *p != isc_info_end; )
{
short length;
char datum = *p++;
length = (short) isc_vax_integer(p, 2);
p += 2;
switch (datum)
{
case isc_info_blob_max_segment:
max_segment = isc_vax_integer(p, length);
break;
case isc_info_blob_total_length:
total_length = isc_vax_integer(p, length);
break;
case isc_info_blob_type:
blob_type = isc_vax_integer(p, length);
break;
default:
croak("Unknown parameter %d", (int)datum);
}
p += length;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth),
"dbd_st_fetch: BLOB info - max_segment: %ld, total_length: %ld, type: %d\n",
max_segment, total_length, blob_type));
if (max_segment == -1L || total_length == -1L || blob_type == -1)
{
isc_cancel_blob(status, &blob_handle);
do_error(sth, 1, "Cannot determine Blob dimensions or type.");
return FALSE;
break;
}
/* if maximum segment size is zero, don't pass it to isc_get_segment() */
if (max_segment == 0)
{
sv_setpv(sv, "");
isc_cancel_blob(status, &blob_handle);
if (ib_error_check(sth, status))
return FALSE;
break;
}
if ((DBIc_LongReadLen(imp_sth) < (unsigned long) total_length) &&
(! DBIc_is(imp_dbh, DBIcf_LongTruncOk)))
{
isc_close_blob(status, &blob_handle);
do_error(sth, 1, "Not enough LongReadLen buffer.");
return FALSE;
break;
}
if (total_length >= MAX_SAFE_BLOB_LENGTH)
{
do_error(sth, 1, "Blob exceeds maximum length.");
sv_setpvn(sv, "** Blob exceeds maximum safe length **", 38);
/* I deliberately don't set FAILURE based on this. */
isc_close_blob(status, &blob_handle);
if (ib_error_check(sth, status))
return FALSE;
break;
}
/* Create a zero-length string. */
sv_setpv(sv, "");
t = total_length;
while (1)
{
blob_stat = isc_get_segment(status, &blob_handle,
&seg_length,
(short) BLOB_SEGMENT,
blob_segment_buffer);
if (status[1] == isc_segstr_eof)
break;
if (status[1] != isc_segment)
if (ib_error_check(sth, status))
{
isc_cancel_blob(status, &blob_handle);
return FALSE;
}
if (seg_length > DBIc_LongReadLen(imp_sth))
break;
/*
* As long as the fetch was successful, concatenate the segment we fetched
* into the growing Perl scalar.
*/
/*
* This is dangerous if the Blob is enormous. But Perl is supposed
* to be able to grow scalars indefinitely as far as resources allow,
* so what the heck. Besides, I limited the max length of a Blob earlier
* to MAX_SAFE_BLOB_LENGTH.
*/
sv_catpvn(sv, blob_segment_buffer, seg_length);
t -= seg_length;
if (t <= 0) break;
if (blob_stat == 100) break;
}
/* Clean up after ourselves. */
isc_close_blob(status, &blob_handle);
if (ib_error_check(sth, status))
return FALSE;
if ( blob_type == isc_blob_text
|| var->sqlsubtype == isc_blob_text )
maybe_upgrade_to_utf8(imp_dbh, sv);
break;
}
case SQL_ARRAY:
#ifdef ARRAY_SUPPORT
!!! NOT IMPLEMENTED YET !!!
#else
sv_setpvn(sv, "** array **", 11);
#endif
break;
default:
sv_setpvn(sv, "** unknown **", 13);
}
/*
* I use the column's alias name because in the absence
* of an alias, it contains the column name anyway.
* Only if the alias AND the column names are zero-length
* do I want to use a generic "COLUMN%d" header.
* This happens, for example, when the column is a
* computed field and the query doesn't use an AS clause
* to label the column.
*/
/*
if (var->aliasname_length > 0)
{
sv_setpvn(sv, var->aliasname, var->aliasname_length));
}
else
{
char s[20];
sprintf(s, "COLUMN%d", i);
sv_setpvn(sv, s, strlen(s));
}
*/
}
}
imp_sth->affected += 1;
return av;
}
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 */
DBIc_ACTIVE_off(imp_sth);
/* if AutoCommit on */
if (DBIc_has(imp_dbh, DBIcf_AutoCommit))
{
DBI_TRACE_imp_xxh(imp_sth, 4, (DBIc_LOGPIO(imp_sth), "dbd_st_finish: Trying to call ib_commit_transaction.\n"));
if (!ib_commit_transaction(sth, imp_dbh))
{
DBI_TRACE_imp_xxh(imp_sth, 4, (DBIc_LOGPIO(imp_sth), "dbd_st_finish: Call ib_commit_transaction finished returned FALSE.\n"));
return FALSE;
}
DBI_TRACE_imp_xxh(imp_sth, 4, (DBIc_LOGPIO(imp_sth), "dbd_st_finish: Call ib_commit_transaction succeded.\n"));
}
return TRUE;
}
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++)
{
FREE_SETNULL(var->sqldata);
FREE_SETNULL(var->sqlind);
}
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_st_destroy: freeing in_sqlda..\n"));
Safefree(imp_sth->in_sqlda);
imp_sth->in_sqlda = NULL;
}
/* freeing out_sqlda */
if (imp_sth->out_sqlda)
{
int i;
XSQLVAR *var = imp_sth->out_sqlda->sqlvar;
for (i = 0; i < imp_sth->out_sqlda->sqld; i++, var++)
{
FREE_SETNULL(var->sqldata);
FREE_SETNULL(var->sqlind);
}
Safefree(imp_sth->out_sqlda);
imp_sth->out_sqlda = NULL;
}
/* free all other resources */
FREE_SETNULL(imp_sth->dateformat);
FREE_SETNULL(imp_sth->timeformat);
FREE_SETNULL(imp_sth->timestampformat);
/* Drop the statement */
if (imp_sth->stmt)
{
isc_dsql_free_statement(status, &(imp_sth->stmt), DSQL_drop);
if (ib_error_check(sth, status))
{
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_st_destroy: isc_dsql_free_statement failed.\n"));
}
else
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_st_destroy: isc_dsql_free_statement succeeded.\n"));
imp_sth->stmt = 0L;
}
/* remove sth from linked list */
/* handle prev element */
if (imp_sth->prev_sth == NULL)
imp_dbh->first_sth = imp_sth->next_sth;
else
imp_sth->prev_sth->next_sth = imp_sth->next_sth;
/* handle next element*/
if (imp_sth->next_sth == NULL)
imp_dbh->last_sth = imp_sth->prev_sth;
else
imp_sth->next_sth->prev_sth = imp_sth->prev_sth;
/* set next/prev to NULL */
imp_sth->prev_sth = imp_sth->next_sth = NULL;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "dbd_st_destroy: sth removed from linked list.\n"));
/* let DBI know we've done it */
if (sth) DBIc_IMPSET_off(imp_sth);
}
SV* dbd_st_FETCH_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv)
{
STRLEN kl;
char *key = SvPV(keysv, kl);
int i;
SV *result = NULL;
/* Default to caching results for DBI dispatch quick_FETCH */
int cacheit = TRUE;
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "dbd_st_FETCH - %s\n", key));
if (kl==13 && strEQ(key, "NUM_OF_PARAMS")) /* handled by DBI */
return Nullsv;
i = DBIc_NUM_FIELDS(imp_sth);
/**************************************************************************/
if (kl==4 && strEQ(key, "TYPE"))
{
AV *av;
if (!imp_sth || !imp_sth->in_sqlda || !imp_sth->out_sqlda)
return Nullsv;
av = newAV();
result = newRV(sv_2mortal((SV*)av));
while(--i >= 0)
av_store(av, i,
newSViv(ib2sql_type(imp_sth->out_sqlda->sqlvar[i].sqltype)));
}
/**************************************************************************/
else if (kl==5 && strEQ(key, "SCALE"))
{
AV *av;
if (!imp_sth || !imp_sth->in_sqlda || !imp_sth->out_sqlda)
return Nullsv;
av = newAV();
result = newRV(sv_2mortal((SV*)av));
while(--i >= 0)
av_store(av, i, newSViv(imp_sth->out_sqlda->sqlvar[i].sqlscale));
}
/**************************************************************************/
else if (kl==9 && strEQ(key, "PRECISION"))
{
AV *av;
if (!imp_sth || !imp_sth->in_sqlda || !imp_sth->out_sqlda)
return Nullsv;
av = newAV();
result = newRV(sv_2mortal((SV*)av));
while(--i >= 0)
av_store(av, i, newSViv(imp_sth->out_sqlda->sqlvar[i].sqllen));
}
/**************************************************************************/
else if (kl==4 && strEQ(key, "NAME"))
{
AV *av;
if (!imp_sth || !imp_sth->in_sqlda || !imp_sth->out_sqlda)
return Nullsv;
av = newAV();
result = newRV(sv_2mortal((SV*)av));
while(--i >= 0)
{
if (imp_sth->out_sqlda->sqlvar[i].aliasname_length > 0)
{
av_store(av, i,
newSVpvn(imp_sth->out_sqlda->sqlvar[i].aliasname,
imp_sth->out_sqlda->sqlvar[i].aliasname_length));
}
else
{
char s[20];
sprintf(s, "COLUMN%d", i);
av_store(av, i, newSVpvn(s, strlen(s)));
}
}
}
/**************************************************************************/
else if (kl==8 && strEQ(key, "NULLABLE"))
{
AV *av;
if (!imp_sth || !imp_sth->in_sqlda || !imp_sth->out_sqlda)
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 */
}
return sv_2mortal(result);
}
int dbd_st_STORE_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv)
{
STRLEN kl;
char *key = SvPV(keysv, kl);
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "dbd_st_STORE - %s\n", key));
return FALSE;
}
int dbd_discon_all(SV *drh, imp_drh_t *imp_drh)
{
dTHR;
/* The disconnect_all concept is flawed and needs more work */
if (!SvTRUE(perl_get_sv("DBI::PERL_ENDING", 0)))
{
sv_setiv(DBIc_ERR(imp_drh), (IV)1);
sv_setpv(DBIc_ERRSTR(imp_drh), (char*)"disconnect_all not implemented");
DBIh_EVENT2(drh, ERROR_event, DBIc_ERR(imp_drh), DBIc_ERRSTR(imp_drh));
return FALSE;
}
if (PL_perl_destruct_level)
PL_perl_destruct_level = 0;
return FALSE;
}
int ib_blob_write(SV *sth, imp_sth_t *imp_sth, XSQLVAR *var, SV *value)
{
D_imp_dbh_from_sth;
isc_blob_handle handle = 0;
ISC_STATUS status[ISC_STATUS_LENGTH];
STRLEN total_length;
char *p, *seg, *string;
int is_text_blob, seg_len;
bool is_utf8;
U8 *encoded;
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "ib_blob_write\n"));
/* we need a transaction */
if (!imp_dbh->tr)
if (!ib_start_transaction(sth, imp_dbh))
return FALSE;
/* alloc mem for blob id */
if (var->sqldata == NULL)
Newxc(var->sqldata, 1, ISC_QUAD, ISC_SCHAR);
/* try to create blob handle */
isc_create_blob2(status, &(imp_dbh->db), &(imp_dbh->tr), &handle,
(ISC_QUAD *)(var->sqldata), 0, NULL);
if (ib_error_check(sth, status))
return FALSE;
is_text_blob = (var->sqlsubtype == isc_bpb_type_stream)? 1: 0; /* SUBTYPE TEXT */
/* get length, pointer to data */
string = SvPV(value, total_length);
if (is_text_blob && imp_dbh->ib_enable_utf8) {
is_utf8 = SvUTF8(value);
encoded = bytes_from_utf8((U8*)string, &total_length, &is_utf8);
}
else encoded = (U8*)string;
/* write it segment by segment */
seg_len = BLOB_SEGMENT;
p = string;
while (total_length > 0)
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "ib_blob_write: %"PRIdMAX" bytes left\n", total_length));
/* set new segment start pointer */
seg = p;
if (is_text_blob)
{
seg_len = 0;
while ((seg_len < BLOB_SEGMENT) && (total_length > 0))
{
total_length--;
p++;
seg_len++;
if (*(p-1) == '\n') break;
}
}
else
{
/* no text blob, set seg len to max possible */
if (total_length < BLOB_SEGMENT)
seg_len = total_length;
/* update segment pointer */
p += seg_len;
total_length -= seg_len;
}
isc_put_segment(status, &handle, (unsigned short) seg_len, seg);
if (ib_error_check(sth, status))
{
if (encoded != (U8*)string)
Safefree(encoded);
isc_cancel_blob(status, &handle);
return FALSE;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "ib_blob_write: %d bytes written\n", seg_len));
}
if (encoded != (U8*)string)
Safefree(encoded);
/* close blob, check for error */
isc_close_blob(status, &handle);
if (ib_error_check(sth, status))
return FALSE;
return TRUE;
}
/* fill in_sqlda with bind parameters */
static int ib_fill_isqlda(SV *sth, imp_sth_t *imp_sth, SV *param, SV *value,
IV sql_type)
{
D_imp_dbh_from_sth;
STRLEN len;
XSQLVAR *ivar;
int retval;
int dtype;
int i = (int)SvIV(param) - 1;
retval = TRUE;
ivar = &(imp_sth->in_sqlda->sqlvar[i]);
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "enter ib_fill_isqlda. processing %d XSQLVAR"
" Type %ld"
" ivar->sqltype=%d\n",
i + 1,
(long) sql_type,
ivar->sqltype));
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: XSQLDA len: %d\n",
imp_sth->in_sqlda->sqln));
/* NULL indicator */
if (!(ivar->sqlind))
Newx(ivar->sqlind, 1, ISC_SHORT);
/* *(ivar->sqlind) = ivar->sqltype & 1 ? 0 : 1; */
*(ivar->sqlind) = 0; /* default assume non-NULL */
/* it should be safe not to free here. test it */
#if 0
if (ivar->sqldata)
{
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: Freeing sqldata\n"));
DBI_TRACE_imp_xxh(imp_sth, 4, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: Freeing sqldata, sqltype is %d\n", ivar->sqltype));
Safefree(ivar->sqldata);
ivar->sqldata = (char *)NULL;
}
#endif
if (!SvOK(value)) /* user passed an undef */
{
if (ivar->sqltype & 1) /* Field is NULLable */
{
/*
* The user has passed 'undef' for this scalar parameter and we use
* this to indicate that the parameter should have a NULL state.
*/
*(ivar->sqlind) = -1; /* NULL */
/*
* Hence no need to fill in sqldata for this sqlvar, because it's
* NULL anyway.Skip to next loop iteration.
*/
return retval;
}
else
{
/*
* User passed an undef to a field that is not nullable.
*/
char err[80];
sprintf(err, "You have not provided a value for non-nullable parameter #%d.", i);
do_error(sth, 1, err);
retval = FALSE;
return retval;
}
}
/* data type minus nullable flag */
dtype = ivar->sqltype & ~1;
/* workaround for date problem (bug #429820) */
if (dtype == SQL_TEXT)
{
if (ivar->sqlsubtype == 0x77)
dtype = SQL_TIMESTAMP;
}
switch (dtype)
{
/**********************************************************************/
case SQL_VARYING:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_VARYING\n"));
{
char *string;
STRLEN len;
bool is_utf8;
U8 *encoded;
string = SvPV(value, len);
if (imp_dbh->ib_enable_utf8) {
is_utf8 = SvUTF8(value);
encoded = bytes_from_utf8((U8*)string, &len, &is_utf8);
/* either returns string (nothing changed, plain ASCII)
or returns a new pointer to encoded octets */
}
else encoded = (U8*)string;
if (len > ivar->sqllen) {
char err[80];
sprintf(err, "String truncation (SQL_VARYING): attempted to bind %lu octets to column sized %lu",
(long unsigned)len, (long unsigned)(sizeof(char) * (ivar->sqllen)));
break;
}
if (!(ivar->sqldata))
Newxz(ivar->sqldata, ivar->sqllen + sizeof(short), char);
*((short *)ivar->sqldata) = len;
Copy((char*)encoded, ivar->sqldata + sizeof(short), len, char);
if (encoded != (U8*)string)
Safefree(encoded);
break;
}
/**********************************************************************/
case SQL_TEXT:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_TEXT\n"));
{
char *string;
STRLEN len;
bool is_utf8;
U8 *encoded;
string = SvPV(value, len);
if (imp_dbh->ib_enable_utf8) {
is_utf8 = SvUTF8(value);
encoded = bytes_from_utf8((U8*)string, &len, &is_utf8);
/* either returns string (nothing changed, plain ASCII)
or returns a new pointer to encoded octets */
}
else encoded = (U8*)string;
if (len > ivar->sqllen) {
char err[80];
sprintf(err, "String truncation (SQL_TEXT): attempted to bind %lu octets to column sized %lu",
(long unsigned)len, (long unsigned)(sizeof(char) * (ivar->sqllen)));
break;
}
if (!(ivar->sqldata))
Newxc(ivar->sqldata, ivar->sqllen, char, ISC_SCHAR);
/* Pad the entire field with blanks */
PoisonWith(ivar->sqldata, ivar->sqllen, char, ' ');
Copy((char*)encoded, ivar->sqldata, len, char);
if (encoded != (U8*)string)
Safefree(encoded);
break;
}
/**********************************************************************/
case SQL_SHORT:
case SQL_LONG:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_SHORT/SQL_LONG\n"));
{
char format[64];
long p, q, r, result;
char *svalue;
/* we need a bit of mem */
if (!(ivar->sqldata)) {
Newxc(ivar->sqldata,
(dtype == SQL_SHORT ? sizeof(short) : sizeof(long)),
char,
ISC_SCHAR);
}
/* See case SQL_INT64 for commentary. */
p = q = r = (long) 0;
svalue = (char *)SvPV(value, len);
/* with decimals? */
if (-ivar->sqlscale)
{
/* numeric(?,?) */
int scale = (int) (pow(10.0, (double) -ivar->sqlscale));
int dscale;
char *tmp;
char *neg;
sprintf(format, "%%ld.%%%dld%%1ld", -ivar->sqlscale);
/* negative -0.x hack */
neg = strchr(svalue, '-');
if (neg)
{
svalue = neg + 1;
len = strlen(svalue);
}
if (!sscanf(svalue, format, &p, &q, &r))
{
/* here we handle values such as .78 passed as string */
sprintf(format, ".%%%dld%%1ld", -ivar->sqlscale);
if (!sscanf(svalue, format, &q, &r) && DBIc_WARN(imp_sth))
warn("problem parsing SQL_LONG type");
}
/* Round up if r is 5 or greater */
if (r >= 5)
{
q++; /* round q up by one */
p += q / scale; /* round p up by one if q overflows */
q %= scale; /* modulus if q overflows */
}
/* decimal scaling */
tmp = strchr(svalue, '.');
dscale = (tmp)? -ivar->sqlscale - (len - (int) (tmp - svalue)) + 1: 0;
if (dscale < 0) dscale = 0;
/* final result */
result = (long) (p * scale + q * (int) (pow(10.0, (double) dscale))) * (neg? -1: 1);
}
/******************************************************************/
else
{
/* numeric(?,0): scan for one decimal and do rounding*/
sprintf(format, "%%ld.%%1ld");
if (!sscanf(svalue, format, &p, &r))
{
sprintf(format, ".%%1ld");
if (!sscanf(svalue, format, &r) && DBIc_WARN(imp_sth))
warn("problem parsing SQL_LONG type");
}
/* rounding */
if (r >= 5)
{
if (p < 0) p--; else p++;
}
/* the final result */
result = (long) p;
}
/* result in short or long? */
if (dtype == SQL_SHORT)
*(short *) (ivar->sqldata) = (short) result;
else
*(long *) (ivar->sqldata) = result;
break;
}
/**********************************************************************/
#ifdef SQL_INT64
case SQL_INT64:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_INT64\n"));
{
char *svalue;
char format[64];
ISC_INT64 p, q, r;
if (!(ivar->sqldata))
Newxc(ivar->sqldata, 1, ISC_INT64, ISC_SCHAR);
/*
* Here I handle both whole and scaled numerics.
* The trick is to avoid converting the Perl scalar
* to an IEEE floating value, because this would
* introduce exactness errors in the conversion from
* base-10 to base-2.
*
* I create a pattern for scanf() to read the whole
* number portion (p), then a number of digits for
* the scale (q), then one more digit (r) for the
* round-up threshold.
*
* Note that sprintf replaces %% with a single %.
* See the man page for sscanf() for more details
* about how it interprets %Ld, %1Ld, etc.
*/
/*
* Define INT64 sscanf formats for various platforms
* using #defines eases the adding of a new platform (compiler/library)
*/
#if defined(_MSC_VER) /* Microsoft C compiler/library */
# define S_INT64_FULL "%%I64d.%%%dI64d%%1I64d"
# define S_INT64_NOSCALE "%%I64d.%%1I64d"
# define S_INT64_DEC_FULL ".%%%dI64d%%1I64d"
# define S_INT64_DEC_NOSCALE ".%%1I64d"
#elif defined (__FreeBSD__) /* FreeBSD */
# define S_INT64_FULL "%%qd.%%%dqd%%1qd"
# define S_INT64_NOSCALE "%%qd.%%1qd"
# define S_INT64_DEC_FULL ".%%%dqd%%1qd"
# define S_INT64_DEC_NOSCALE ".%%1qd"
#else /* others: linux, various unices */
# define S_INT64_FULL "%%lld.%%%dlld%%1lld"
# define S_INT64_NOSCALE "%%lld.%%1lld"
# define S_INT64_DEC_FULL ".%%%dlld%%1lld"
# define S_INT64_DEC_NOSCALE ".%%1lld"
#endif
p = q = r = (ISC_INT64) 0;
svalue = (char *)SvPV(value, len);
/* with decimals? */
if (-ivar->sqlscale)
{
/* numeric(?,?) */
int scale = (int) (pow(10.0, (double) -ivar->sqlscale));
int dscale;
char *tmp;
char *neg;
sprintf(format, S_INT64_FULL, -ivar->sqlscale);
/* negative -0.x hack */
neg = strchr(svalue, '-');
if (neg)
{
svalue = neg + 1;
len = strlen(svalue);
}
if (!sscanf(svalue, format, &p, &q, &r))
{
/* here we handle values such as .78 passed as string */
sprintf(format, S_INT64_DEC_FULL, -ivar->sqlscale);
if (!sscanf(svalue, format, &q, &r) && DBIc_WARN(imp_sth))
warn("problem parsing SQL_INT64 type");
}
#ifdef __BORLANDC__
p = _atoi64(svalue);
#endif
/* Round up if r is 5 or greater */
if (r >= 5)
{
q++; /* round q up by one */
p += q / scale; /* round p up by one if q overflows */
q %= scale; /* modulus if q overflows */
}
/* decimal scaling */
tmp = strchr(svalue, '.');
dscale = (tmp)? -ivar->sqlscale - (len - (int) (tmp - svalue)) + 1: 0;
if (dscale < 0) dscale = 0;
/* final result */
*(ISC_INT64 *) (ivar->sqldata) = (ISC_INT64) (p * scale + q * (int) (pow(10.0, (double) dscale))) * (neg? -1: 1);
}
/******************************************************************/
else
{
/* numeric(?,0): scan for one decimal and do rounding*/
sprintf(format, S_INT64_NOSCALE);
if (!sscanf(svalue, format, &p, &r))
{
sprintf(format, S_INT64_DEC_NOSCALE);
if (!sscanf(svalue, format, &r) && DBIc_WARN(imp_sth))
warn("problem parsing SQL_INT64 type");
}
/* rounding */
if (r >= 5)
{
if (p < 0) p--; else p++;
}
/* the final result */
*(ISC_INT64 *) (ivar->sqldata) = (ISC_INT64) p;
}
break;
}
#endif
/**********************************************************************/
case SQL_FLOAT:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_FLOAT\n"));
if (!(ivar->sqldata))
Newxc(ivar->sqldata, 1, float, ISC_SCHAR);
*(float *) (ivar->sqldata) = (float) SvNV(value);
break;
/**********************************************************************/
case SQL_DOUBLE:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_DOUBLE\n"));
if (!(ivar->sqldata))
Newxc(ivar->sqldata, 1, double, ISC_SCHAR);
*(double *) (ivar->sqldata) = SvNV(value);
break;
/**********************************************************************/
case SQL_TIMESTAMP:
case SQL_TYPE_TIME:
case SQL_TYPE_DATE:
if (SvPOK(value) || SvTYPE(value) == SVt_PVMG)
{
/*
* Coerce the date literal into a CHAR string, so as
* to allow Firebird's internal date-string parsing
* to interpret the date.
*/
char *datestring = SvPV(value, len);
ivar->sqltype = SQL_TEXT | (ivar->sqltype & 1);
/* prevent overflow */
if (len > 100) {
do_error(sth, 2, "DATE input parameter too long, but will try...\n");
len = 100;
}
/* workaround for date problem (bug #429820) */
ivar->sqlsubtype = 0x77; /* (0x77 is a random value) */
ivar->sqllen = len;
/*
* I should not allocate based on len, I should allocate
* a fixed length based on the max date/time string.
* For now let's just call it 100. Okay, 101.
*/
if (!(ivar->sqldata))
Newx(ivar->sqldata, 101, ISC_SCHAR);
Copy(datestring, ivar->sqldata, len, ISC_SCHAR);
ivar->sqldata[len] = '\0';
}
else if (SvROK(value))
{
struct tm times; /* unix time struct */
AV *list = (AV *) SvRV(value); /* AV with time items */
SV **svp = AvARRAY(list); /* AV as a C array */
int items = av_len(list) + 1; /* item count in array */
/* check if we have enough items in the list */
if (items < 5) /* we ignore wday, yday, isdst */
{
do_error(sth, 2, "Cannot bind date/time value. Not enough"
"items in localtime() style array");
retval = FALSE;
break;
}
/* fill in struct tm fields */
times.tm_sec = SvIV(svp[0]);
times.tm_min = SvIV(svp[1]);
times.tm_hour = SvIV(svp[2]);
times.tm_mday = SvIV(svp[3]);
times.tm_mon = SvIV(svp[4]);
times.tm_year = SvIV(svp[5]);
/* free ivar->sqldata (prior call wasn't necessary an localtimes
* style list) */
if (ivar->sqldata)
Safefree(ivar->sqldata);
/* encode for firebird/interbase, store value*/
switch (dtype)
{
case SQL_TIMESTAMP:
{
ISC_TIMESTAMP timestamp;
isc_encode_timestamp(×, ×tamp);
Newxc(ivar->sqldata, 1, ISC_TIMESTAMP, ISC_SCHAR);
if (items >= 10)
TIMESTAMP_ADD_FPSECS(×tamp, SvIV(svp[9]));
*(ISC_TIMESTAMP *) ivar->sqldata = timestamp;
break;
}
case SQL_TYPE_TIME:
{
ISC_TIME sql_time;
isc_encode_sql_time(×, &sql_time);
Newxc(ivar->sqldata, 1, ISC_TIME, ISC_SCHAR);
if (items >= 10)
TIME_ADD_FPSECS(&sql_time, SvIV(svp[9]));
*(ISC_TIME *) ivar->sqldata = sql_time;
break;
}
case SQL_TYPE_DATE:
{
ISC_DATE sql_date;
isc_encode_sql_date(×, &sql_date);
Newxc(ivar->sqldata, 1, ISC_DATE, ISC_SCHAR);
*(ISC_DATE *) ivar->sqldata = sql_date;
break;
}
}
}
break;
/**********************************************************************/
case SQL_BLOB:
DBI_TRACE_imp_xxh(imp_sth, 1, (DBIc_LOGPIO(imp_sth), "ib_fill_isqlda: SQL_BLOB\n"));
/* SELECT's can't have a blob as in_sqlda. */
if ((imp_sth->type == isc_info_sql_stmt_select) ||
(imp_sth->type == isc_info_sql_stmt_select_for_upd))
{
do_error(sth, 2, "BLOB as an input param for SELECT is not allowed.\n");
retval = FALSE;
break;
}
else
/* we have an extra function for this */
retval = ib_blob_write(sth, imp_sth, ivar, value);
break;
/**********************************************************************/
case SQL_ARRAY:
#ifdef ARRAY_SUPPORT
!!! NOT IMPLEMENTED YET !!!
#endif
break;
default:
break;
}
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "exiting ib_fill_isqlda: %d\n", retval));
return retval;
}
int dbd_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *param, SV *value,
IV sql_type, SV *attribs, int is_inout, IV maxlen)
{
DBI_TRACE_imp_xxh(imp_sth, 2, (DBIc_LOGPIO(imp_sth), "dbd_bind_ph\n"));
if (SvTYPE(value) > SVt_PVLV)
croak("Can't bind a non-scalar value (%s)", neatsvpv(value,0));
/* is_inout for stored procedure is not implemented yet */
if (is_inout)
croak("Can't bind ``lvalue'' mode.");
if (!imp_sth || !imp_sth->in_sqlda)
return FALSE;
/* param is the number of parameter: 1, 2, 3, or ... */
if ((int)SvIV(param) > imp_sth->in_sqlda->sqld)
return TRUE;
DBI_TRACE_imp_xxh(imp_sth, 3, (DBIc_LOGPIO(imp_sth), "Binding parameter: %d\n", (int)SvIV(param)));
return ib_fill_isqlda(sth, imp_sth, param, value, sql_type);
}
int ib_start_transaction(SV *h, imp_dbh_t *imp_dbh)
{
ISC_STATUS status[ISC_STATUS_LENGTH];
if (imp_dbh->tr)
{
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "ib_start_transaction: trans handle already started.\n"));
return TRUE;
}
/* MUST initialized to 0, before it is used */
imp_dbh->tr = 0L;
isc_start_transaction(status, &(imp_dbh->tr), 1, &(imp_dbh->db),
imp_dbh->tpb_length, imp_dbh->tpb_buffer);
if (ib_error_check(h, status))
return FALSE;
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "ib_start_transaction: transaction started.\n"));
return TRUE;
}
int ib_commit_transaction(SV *h, imp_dbh_t *imp_dbh)
{
ISC_STATUS status[ISC_STATUS_LENGTH];
DBI_TRACE_imp_xxh(imp_dbh, 4, (DBIc_LOGPIO(imp_dbh),
"ib_commit_transaction: DBIcf_AutoCommit = %lu, imp_dbh->sth_ddl = %u\n",
(long unsigned)DBIc_has(imp_dbh, DBIcf_AutoCommit), imp_dbh->sth_ddl));
if (!imp_dbh->tr)
{
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh),
"ib_commit_transaction: transaction already NULL.\n"));
/* In case we switched to use different TPB before we actually use */
/* This transaction handle */
imp_dbh->sth_ddl = 0;
return TRUE;
}
/* do commit */
if ((imp_dbh->sth_ddl == 0) && (imp_dbh->soft_commit))
{
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "try isc_commit_retaining\n"));
/* commit but don't close transaction */
isc_commit_retaining(status, &(imp_dbh->tr));
if (ib_error_check(h, status))
return FALSE;
}
else
{
/* close all open statement handles */
/* if ((imp_dbh->sth_ddl > 0) || !(DBIc_has(imp_dbh, DBIcf_AutoCommit))) */
/* remark: only necessary when we have DDL statement(s) */
if (imp_dbh->sth_ddl > 0)
{
while (imp_dbh->first_sth != NULL)
{
/* finish and destroy sth */
dbd_st_finish((SV*)DBIc_MY_H(imp_dbh->first_sth), imp_dbh->first_sth);
dbd_st_destroy(NULL, imp_dbh->first_sth);
}
imp_dbh->sth_ddl = 0;
}
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "try isc_commit_transaction\n"));
/* commit and close transaction (sets handle to NULL) */
isc_commit_transaction(status, &(imp_dbh->tr));
if (ib_error_check(h, status))
return FALSE;
imp_dbh->tr = 0L;
}
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "ib_commit_transaction succeed.\n"));
return TRUE;
}
int ib_rollback_transaction(SV *h, imp_dbh_t *imp_dbh)
{
ISC_STATUS status[ISC_STATUS_LENGTH];
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "ib_rollback_transaction\n"));
if (!imp_dbh->tr)
{
DBI_TRACE_imp_xxh(imp_dbh, 3, (DBIc_LOGPIO(imp_dbh), "ib_rollback_transaction: transaction already NULL.\n"));
imp_dbh->sth_ddl = 0;
return TRUE;
}
/* no isc_rollback_retaining in IB prior to 6 */
if ((imp_dbh->sth_ddl == 0) && (imp_dbh->soft_commit))
{
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "try isc_rollback_retaining\n"));
/* rollback but don't close transaction */
isc_rollback_retaining(status, &(imp_dbh->tr));
if (ib_error_check(h, status))
return FALSE;
}
else
{
/* close all open statement handles */
if ((imp_dbh->sth_ddl > 0) || !(DBIc_has(imp_dbh, DBIcf_AutoCommit)))
{
while (imp_dbh->first_sth != NULL)
{
/* finish and destroy sth */
dbd_st_finish((SV*)DBIc_MY_H(imp_dbh->first_sth), imp_dbh->first_sth);
dbd_st_destroy(NULL, imp_dbh->first_sth);
}
imp_dbh->sth_ddl = 0;
}
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "try isc_rollback_transaction\n"));
/* rollback and close transaction (sets handle to NULL) */
isc_rollback_transaction(status, &(imp_dbh->tr));
if (ib_error_check(h, status))
return FALSE;
imp_dbh->tr = 0L;
}
DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "ib_rollback_transaction succeed\n"));
return TRUE;
}
int dbd_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field,
long offset, long len, SV *destrv, long destoffset)
{
return FALSE;
}
int dbd_st_rows(SV* sth, imp_sth_t* imp_sth)
{
/* spot common mistake of checking $h->rows just after ->execut
if (imp_sth->affected < 0
&& DBIc_WARN(imp_sth)
) {
warn("$h->rows count is incomplete before all rows fetched.\n");
}
*/
return imp_sth->affected;
}
long ib_rows(SV *xxh, isc_stmt_handle *h_stmt, char count_type)
{
ISC_STATUS status[ISC_STATUS_LENGTH];
short l;
char count_is;
char count_info[1], count_buffer[33];
char *p;
long row_count = -1;
count_info[0] = isc_info_sql_records;
if (isc_dsql_sql_info(status, h_stmt,
sizeof(count_info), count_info,
sizeof(count_buffer), count_buffer))
{
if (ib_error_check(xxh, status))
return -2; /* error */
}
for (p = count_buffer + 3; *p != isc_info_end;) {
count_is = *p++;
l = (short) isc_vax_integer(p, 2);
p += 2;
row_count = (long) isc_vax_integer(p, l);
p += l;
if (count_is == count_type)
break;
}
return row_count;
}
/* end */