DBD-IngresII
view release on metacpan or search on metacpan
EXEC SQL END DECLARE SECTION;
EXEC SQL SELECT INT4(DBMSINFO('AUTOCOMMIT_STATE'))
INTO :autocommit_state;
if (!sql_check(dbh)) return 0;
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_db_connect(AUTOCOMMIT=%d)\n",
autocommit_state);
DBIc_set(imp_dbh, DBIcf_AutoCommit, autocommit_state);
if (!autocommit_state)
{
EXEC SQL COMMIT;
if (!sql_check(dbh))
return 0;
}
}
/* Set default value for LongReadLen */
DBIc_LongReadLen(imp_dbh) = 2UL * 1024 * 1024 * 1024;
/* Set default values for attributes */
imp_dbh->ing_rollback = 0;
imp_dbh->ing_enable_utf8 = 0;
imp_dbh->ing_empty_isnull = 0;
imp_dbh->ing_long_chunk_size = 65536;
imp_dbh->ing_long_use_stack = 1;
return 1;
}
int
dbd_db_do(dbh, statement)
SV *dbh;
EXEC SQL BEGIN DECLARE SECTION;
char *statement;
EXEC SQL END DECLARE SECTION;
{
D_imp_dbh(dbh);
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_db_do(\"%s\")\n", statement);
set_session(dbh);
EXEC SQL EXECUTE IMMEDIATE :statement;
if (!sql_check(dbh))
return -1;
else
return sqlca.sqlerrd[2]; /* rowcount */
}
int
dbd_db_commit(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
dTHR;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_db_commit\n");
/* Check for commit() being called whilst refs to cursors */
/* still exists. This needs some more thought. */
if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty)
{
warn("DBD::Ingres::commit(%s) invalidates %d active cursor(s)",
SvPV(dbh,PL_na), (int)DBIc_ACTIVE_KIDS(imp_dbh));
}
set_session(dbh);
++ imp_dbh->trans_no;
EXEC SQL COMMIT;
return sql_check(dbh);
}
int
dbd_db_rollback(dbh, imp_dbh)
SV *dbh;
imp_dbh_t *imp_dbh;
{
dTHR;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_db_rollback\n");
/* Check for commit() being called whilst refs to cursors */
/* still exists. This needs some more thought. */
if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty)
{
warn("DBD::Ingres::rollback(%s) invalidates %d active cursor(s)",
SvPV(dbh,PL_na), (int)DBIc_ACTIVE_KIDS(imp_dbh));
}
set_session(dbh);
++ imp_dbh->trans_no;
EXEC SQL ROLLBACK;
return sql_check(dbh);
}
SV*
dbd_db_get_dbevent(dbh, imp_dbh, wait)
SV *dbh;
imp_dbh_t *imp_dbh;
SV *wait;
{
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_get_dbevent\n");
set_session(dbh);
if (!wait || !SvOK(wait) || !SvIOK(wait))
{
EXEC SQL GET DBEVENT WITH WAIT;
}
else
{
EXEC SQL BEGIN DECLARE SECTION;
int seconds;
EXEC SQL END DECLARE SECTION;
seconds = (int)SvIV(wait);
EXEC SQL GET DBEVENT WITH WAIT = :seconds;
}
if (!sql_check(dbh))
return (&PL_sv_undef);
{
HV *result;
EXEC SQL BEGIN DECLARE SECTION;
char event_name [80];
char event_database[80];
char event_owner [80];
char event_text [256];
char event_time [26];
EXEC SQL END DECLARE SECTION;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP, "dbd_db_inquire_event\n");
set_session(dbh);
EXEC SQL INQUIRE_INGRES
(:event_name = DBEVENTNAME,
:event_database = DBEVENTDATABASE,
:event_text = DBEVENTTEXT,
:event_owner = DBEVENTOWNER,
:event_time = DBEVENTTIME
);
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP, "eventname = %s\n", event_name);
if (!sql_check(dbh)) return (&PL_sv_undef);
if (!*event_name) return (&PL_sv_undef);
result = newHV();
** used!*/
*var->sqlind = -1;
var->sqltype = -var->sqltype;
}
if (dbis->debug >= 3)
dump_sqlda(&imp_sth->ph_sqlda);
return 1;
}
int
dbd_st_execute(sth, imp_sth)
/* >=0: OK, no of rows affected,
** -1: OK, unknown number of rows affected,
** -2: error */
SV *sth;
imp_sth_t *imp_sth;
{
EXEC SQL BEGIN DECLARE SECTION;
char* name = imp_sth->name;
EXEC SQL END DECLARE SECTION;
dTHR;
D_imp_dbh_from_sth;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP, "DBD::Ingres::dbd_st_execute(%s)\n", imp_sth->name);
/* needs to check for re-prepare (after commit etc.) */
if (imp_sth->trans_no != imp_dbh->trans_no)
croak("DBD::Ingres: Attempt to execute a statement after commit");
if (!imp_sth->done_desc)
/* describe and allocate storage for results */
if (!dbd_describe(sth, imp_sth))
return -2; /* dbd_describe already called sql_check() */
/* Trigger execution of the statement */
set_session(DBIc_PARENT_H(imp_sth));
if (DBIc_NUM_FIELDS(imp_sth) == 0)
{
/* non-select statement: just execute it */
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,
"DBD::Ingres::dbd_st_execute - non-select, param=%d\n",
imp_sth->ph_sqlda.sqld);
if (imp_sth->ph_sqlda.sqld > 0)
{
EXEC SQL EXECUTE :name USING DESCRIPTOR &imp_sth->ph_sqlda;
}
else {
EXEC SQL EXECUTE :name;
}
return sql_check(sth) ? sqlca.sqlerrd[2] : -2;
}
else
{
int is_readonly;
/* select statement: open a cursor */
EXEC SQL DECLARE :name CURSOR FOR :name;
/* 0.23 open readonly unless an "FOR UPDATE"- clause is found in */
/* select statement. This is done in Ingres.pm in prepare, and */
/* is stored in the private variable $sth->{ing_readonly}. */
{
SV **svp;
if ( (svp = hv_fetch((HV*)SvRV(sth), "ing_readonly", 12, 0)) != NULL
&& SvTRUE(*svp))
{
is_readonly = 1;
}
else
is_readonly = 0;
}
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,
"DBD::Ingres::dbd_st_execute - cursor %s - param=%d %sreadonly\n",
name, imp_sth->ph_sqlda.sqld, is_readonly ? "" : "NOT ");
if (is_readonly)
if (imp_sth->ph_sqlda.sqld > 0)
{
EXEC SQL OPEN :name FOR READONLY
USING DESCRIPTOR &imp_sth->ph_sqlda;
}
else
EXEC SQL OPEN :name FOR READONLY;
else
{
if (imp_sth->ph_sqlda.sqld > 0)
{
EXEC SQL OPEN :name
USING DESCRIPTOR &imp_sth->ph_sqlda;
}
else
EXEC SQL OPEN :name;
}
if (!sql_check(sth))
return -2;
DBIc_ACTIVE_on(imp_sth);
return -1 /* Unknown number of rows */;
}
}
AV *
dbd_st_fetch(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
IISQLDA *sqlda;
IV num_fields;
int i;
AV *av;
EXEC SQL BEGIN DECLARE SECTION;
char *name = imp_sth->name;
EXEC SQL END DECLARE SECTION;
D_imp_dbh_from_sth;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_st_fetch(%s)\n", imp_sth->name);
/* needs to check for re-prepare (after commit etc.) */
if (imp_sth->trans_no != imp_dbh->trans_no)
croak("DBD::Ingres: Attempt to fetch from statement after commit");
if (!DBIc_ACTIVE(imp_sth))
{
error(sth, -7, "fetch without open cursor", 0);
return Nullav;
}
set_session(DBIc_PARENT_H(imp_sth));
sqlda = &imp_sth->sqlda;
if (dbis->debug >= 5)
PerlIO_printf(DBILOGFP,
"DBD::Ingres::dbd_st_fetch SRE before SQL FETCH\n");
EXEC SQL FETCH :name USING DESCRIPTOR :sqlda;
if (dbis->debug >= 5)
PerlIO_printf(DBILOGFP,
"DBD::Ingres::dbd_st_fetch SRE after SQL FETCH\n");
if (sqlca.sqlcode == 100)
{
dbd_st_finish(sth, imp_sth);
return Nullav;
}
else
if (!sql_check(sth))
return Nullav;
/* Something was fetched, put the fields into the array */
av = DBIS->get_fbav(imp_sth);
num_fields = AvFILL(av)+1;
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, " dbd_st_fetch %ld fields\n", (long)num_fields);
for(i=0; i < num_fields; ++i)
{
imp_fbh_t *fbh = &imp_sth->fbh[i];
IISQLVAR *var = fbh->var;
SV *sv = AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, " Field #%d: ", i);
if (fbh->indic == -1)
{
/* NULL value */
(void)SvOK_off(sv);
if (dbis->debug >= 3) PerlIO_printf(DBILOGFP, "NULL\n");
}
else
{
switch (fbh->type[0])
{
case 'd':
if (abs(var->sqltype) == IISQ_BOO_TYPE)
sv_setiv(sv, *(int*)var->sqldata);
else
sv_setiv(sv, *(IV*)var->sqldata);
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, "Int: %ld %ld\n",
(long)SvIV(sv), (long)*(IV*)var->sqldata);
break;
case 'f':
sv_setnv(sv, *(double*)var->sqldata);
if (dbis->debug >= 3)
case 'l':
if (!DBIc_has(imp_sth, DBIcf_LongTruncOk) && fbh->indic == 1)
{
(void)SvOK_off(sv);
error(sth, -7, "Data size larger than LongReadLen", 0);
return Nullav;
}
sv_setsv(sv, fbh->sv);
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, "Long data (%ld)\n", (long)SvCUR(sv));
break;
default:
croak("DBD::Ingres: wierd field-type '%s' in field no. %d?\n",
fbh->type, i);
}
}
}
#ifdef _WIN32
/* See comment above dummy_ctrl_c_handler() function */
SetConsoleCtrlHandler(NULL, FALSE);
SetConsoleCtrlHandler((PHANDLER_ROUTINE)dummy_ctrl_c_handler, TRUE);
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, "Installed dummy CTRL+C handler as workaround to bug in Ingres \n");
#endif
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, " End fetch\n");
return av;
}
int
dbd_st_rows(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
EXEC SQL BEGIN DECLARE SECTION;
int rowcount;
EXEC SQL END DECLARE SECTION;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP, "dbd_rows\n");
set_session(DBIc_PARENT_H(imp_sth));
EXEC SQL INQUIRE_INGRES(:rowcount = ROWCOUNT);
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP, "rowcount = %d\n", rowcount);
if (!sql_check(sth)) return -1;
else return rowcount;
}
int
dbd_st_finish(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
EXEC SQL BEGIN DECLARE SECTION;
char *name = imp_sth->name;
EXEC SQL END DECLARE SECTION;
dTHR;
/* Cancel further fetches from this cursor. */
if (DBIc_ACTIVE(imp_sth))
{
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_st_finish(%s)\n",
imp_sth->name);
set_session(DBIc_PARENT_H(imp_sth));
EXEC SQL CLOSE :name;
}
DBIc_ACTIVE_off(imp_sth);
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_st_finish(%s)\n", imp_sth->name);
return 1;
}
void
dbd_st_destroy(sth, imp_sth)
SV *sth;
imp_sth_t *imp_sth;
{
int i;
if (dbis->debug >= 2)
PerlIO_printf(DBILOGFP,"DBD::Ingres::dbd_st_destroy(%s)\n",
imp_sth->name);
release_statement(imp_sth->st_num);
for (i=0; i<DBIc_NUM_PARAMS(imp_sth); ++i)
{
IISQLVAR *var = &imp_sth->ph_sqlda.sqlvar[i];
if (var->sqldata != 0)
{
if (var->sqltype == IISQ_HDLR_TYPE)
{
IISQLHDLR *hdlr = (IISQLHDLR *)var->sqldata;
SvREFCNT_dec((SV *)hdlr->sqlarg);
}
Safefree(var->sqldata);
}
}
if (imp_sth->done_desc)
{
IISQLDA *sqlda = &imp_sth->sqlda;
for (i=0; i<sqlda->sqld; i++)
{
imp_fbh_t *fbh = &imp_sth->fbh[i];
SvREFCNT_dec(fbh->sv);
if (fbh->type[0] == 'l')
Safefree(fbh->var->sqldata);
}
Safefree(imp_sth->fbh);
}
Safefree(imp_sth->name);
DBIc_IMPSET_off(imp_sth);
}
( run in 0.657 second using v1.01-cache-2.11-cpan-39bf76dae61 )