DBD-Ingres
view release on metacpan or search on metacpan
cur_session = imp_dbh->session;
if (!sql_check(dbh)) return 0;
DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */
{
/* get default autocommit state, so DBI knows about it */
EXEC SQL BEGIN DECLARE SECTION;
int autocommit_state;
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 value for ing_rollback */
imp_dbh->ing_rollback = 0;
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) && !dirty) {
warn("DBD::Ingres::commit(%s) invalidates %d active cursor(s)",
SvPV(dbh,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) && !dirty) {
warn("DBD::Ingres::rollback(%s) invalidates %d active cursor(s)",
SvPV(dbh,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 (&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 (&sv_undef);
if (!*event_name) return (&sv_undef);
result = newHV();
hv_store(result, "name", sizeof("name") -1,
newSVpv(event_name, 0),0);
hv_store(result, "database", sizeof("database")-1,
/* We don't renew here, on the assumption that all of the
* data types above allocate space >= sizeof(short). */
var->sqlind = (short*)var->sqldata; /* cheat a little - use
** var->sqldata as indicator
** variable as well - the
** actual value is never
** 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;
int 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 %d fields\n", num_fields);
for(i=0; i < num_fields; ++i) {
imp_fbh_t *fbh = &imp_sth->fbh[i];
IISQLVAR *var = fbh->var;
int ch;
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':
sv_setiv(sv, (IV)*(int*)var->sqldata);
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, "Int: %ld %d\n",
SvIV(sv), *(int*)var->sqldata);
break;
case 'f':
sv_setnv(sv, *(double*)var->sqldata);
if (dbis->debug >= 3)
PerlIO_printf(DBILOGFP, "Double: %lf\n", SvNV(sv));
break;
case 's': {
short len = *(short *)var->sqldata;
char *buf = var->sqldata + sizeof(short);
/* strip trailing blanks */
if ((fbh->origtype == IISQ_DTE_TYPE ||
fbh->origtype == IISQ_CHA_TYPE ||
fbh->origtype == IISQ_TXT_TYPE)
&& DBIc_has(imp_sth, DBIcf_ChopBlanks)) {
while (len > 0 && buf[len-1] == ' ') {
len--;
}
}
buf[len] = '\0';
sv_setpvn(sv, buf, len);
if (dbis->debug >= 3) {
PerlIO_printf(DBILOGFP, "Text: '");
PerlIO_write(DBILOGFP, buf, len);
PerlIO_printf(DBILOGFP, "', Chop: %d\n",
DBIc_has(imp_sth, DBIcf_ChopBlanks));
}
break; }
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 (%d)\n", SvCUR(sv));
break;
default:
croak("DBD::Ingres: wierd field-type '%s' in field no. %d?\n",
fbh->type, i);
}
}
}
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;
D_imp_dbh_from_sth;
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);
}
int
dbd_st_blob_read(sth, imp_sth,
field, offset, len, destrv, destoffset)
SV *sth;
imp_sth_t *imp_sth;
( run in 0.814 second using v1.01-cache-2.11-cpan-5837b0d9d2c )