DBD-Unify
view release on metacpan or search on metacpan
/* Until those babys are able to change their own dirty nappies ... */
static void change_offspring (SV *dbh, imp_dbh_t *imp_dbh) {
imp_sth_t **children;
int i, n;
/* Make this function extremely precautious ;-P */
unless (imp_dbh) return;
unless (children = imp_dbh->children) return;
unless ((n = imp_dbh->nchildren) > 0) return;
for (i = 0; i < n; i++) {
imp_sth_t *imp_sth = children[i];
if (!imp_sth || imp_sth->stat > ST_STAT_OPEN
|| imp_sth->stat & ST_STAT_OPEN) continue;
if (2 > DBIc_TRACE_LEVEL (imp_sth) && 2 > dbd_verbose) {
dbg (3, "-- %03d/%03d 0x%08X %02X",
i + 1, n, imp_sth, imp_sth ? imp_sth->stat : 0);
if (imp_sth && imp_sth->statement)
dbg (3, " '%s'", imp_sth->statement);
dbg (3, "\n");
}
dbd_st_destroy (dbh, imp_sth);
}
} /* change_offspring */
static void dbd_st_diaper (imp_dbh_t *imp_dbh, imp_sth_t *imp_sth) {
imp_sth_t **children = imp_dbh->children;
int i, n = imp_dbh->nchildren;
for (i = 0; i < n; i++) {
if (children[i]) continue;
children[i] = imp_sth;
return;
}
if (n) imp_dbh->children = (imp_sth_t **)realloc ((void *)imp_dbh->children, (imp_dbh->nchildren + 1) * sizeof (imp_sth_t *));
else imp_dbh->children = (imp_sth_t **) malloc (sizeof (imp_sth_t *));
if (imp_dbh->children) imp_dbh->children[imp_dbh->nchildren++] = imp_sth;
else imp_dbh->nchildren = 0;
} /* dbd_st_diaper */
static void dbd_st_growup (imp_dbh_t *imp_dbh, imp_sth_t *imp_sth) {
imp_sth_t **children = imp_dbh->children;
int i, n = imp_dbh->nchildren;
for (i = 0; i <= n; i++) {
unless (children[i] == imp_sth) continue;
imp_dbh->children[i] = 0;
return;
}
} /* dbd_st_growup */
int dbd_db_commit (SV *dbh, imp_dbh_t *imp_dbh) {
dTHX;
dbg (3, "DBD::Unify::db_commit\n");
unless (DBIc_ACTIVE (imp_dbh))
return (0);
change_offspring (dbh, imp_dbh);
/* 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::Unify::db_commit (%s) invalidates %d active cursor(s)",
SvPV_nolen (dbh), (int)DBIc_ACTIVE_KIDS (imp_dbh));
}
EXEC SQL
COMMIT WORK;
return (sqlError (dbh));
} /* dbd_db_commit */
int dbd_db_rollback (SV *dbh, imp_dbh_t *imp_dbh) {
dTHX;
dbg (3, "DBD::Unify::db_rollback\n");
unless (DBIc_ACTIVE (imp_dbh))
return (0);
change_offspring (dbh, imp_dbh);
/* Check for rollback () being called whilst refs to cursors
* still exists. See dbd_db_commit ()
*/
if (DBIc_ACTIVE_KIDS (imp_dbh) && DBIc_WARN (imp_dbh) && !PL_dirty) {
warn ("DBD::Unify::db_rollback (%s) invalidates %d active cursor(s)",
SvPV_nolen (dbh), (int)DBIc_ACTIVE_KIDS (imp_dbh));
}
EXEC SQL
ROLLBACK WORK;
return (sqlError (dbh));
} /* dbd_db_rollback */
int dbd_db_dict (SV *dbh, int reload) {
dTHX;
D_imp_dbh (dbh);
dbg (3, "DBD::Unify::db_dict (%d)\n", reload);
_db_dict (reload);
sv_setsv (DEFSV, newRV_noinc ((SV *)h_dd)); /* $_ = \%db */
return (1);
} /* dbd_db_dict */
int dbd_db_do (SV *dbh, char *statement) {
dTHX;
D_imp_dbh (dbh);
dbg (3, "DBD::Unify::db_do (\"%s\")\n", statement);
unless (DBIc_ACTIVE (imp_dbh))
return (0);
if (strlen (statement) >= MAX_SQL_LEN) {
warn ("DBD::Unify::db_do (\"%.40s ...\") statement too long", statement);
return (0);
}
(void)strcpy (u_sql_do, statement);
EXEC SQL
EXECUTE IMMEDIATE :u_sql_do;
dbg (4, " After execute, sqlcode = %d\n", SQLCODE);
unless (sqlError (dbh))
return (0);
return (1);
} /* dbd_db_do */
int dbd_db_disconnect (SV *dbh, imp_dbh_t *imp_dbh) {
dTHX;
dbg (3, "DBD::Unify::db_disconnect\n");
unless (DBIc_ACTIVE (imp_dbh))
return (0);
change_offspring (dbh, imp_dbh);
if (imp_dbh->nchildren) {
if (imp_dbh->children) free ((void *)imp_dbh->children);
imp_dbh->children = (imp_sth_t **)0;
imp_dbh->nchildren = 0;
}
if (DBIc_ACTIVE_KIDS (imp_dbh) && DBIc_WARN (imp_dbh) && !PL_dirty) {
warn ("DBD::Unify::db_disconnect (%s) invalidates %d active cursor(s)",
SvPV_nolen (dbh), (int)DBIc_ACTIVE_KIDS (imp_dbh));
}
DBIc_ACTIVE_off (imp_dbh);
EXEC SQL
DISCONNECT;
dbg (4, " After disconn, sqlcode = %d\n", SQLCODE);
imp_dbh->id = 0;
/* We assume that disconnect will always work
* since most errors imply already disconnected.
*/
return (sqlError (dbh));
} /* dbd_db_disconnect */
int dbd_discon_all (SV *drh, imp_drh_t *imp_drh) {
dTHX;
if (!PL_dirty && !SvTRUE (perl_get_sv ("DBI::PERL_ENDING", 0))) {
sv_setiv (DBIc_ERR (imp_drh), (IV)1);
sv_setpv (DBIc_ERRSTR (imp_drh), "disconnect_all not implemented");
(void)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);
} /* dbd_discon_all */
void dbd_db_destroy (SV *dbh, imp_dbh_t *imp_dbh) {
dTHX;
dbg (3, "DBD::Unify::db_destroy\n");
if (DBIc_ACTIVE (imp_dbh))
dbd_db_disconnect (dbh, imp_dbh);
DBIc_IMPSET_off (imp_dbh);
/* No, share it among all DB handles
(void)free (sth_id_on);
*/
} /* dbd_db_destroy */
int dbd_db_STORE_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv) {
dTHX;
STRLEN kl;
char *key = SvPV (keysv, kl);
unless (DBIc_ACTIVE (imp_dbh))
return (0);
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose"))) {
dbd_verbose = SvIV (valuesv); /* dbd_verbose in DBD::Oracle since 1.22 :) */
dbg (2, "Set DBD_VERBOSE = %d\n", dbd_verbose);
return (TRUE);
}
if (kl == 10 && strEQ (key, "AutoCommit")) {
DBIc_set (imp_dbh, DBIcf_AutoCommit, 0); /* Allways off */
return (TRUE);
}
if (kl == 11 && strEQ (key, "uni_unicode")) {
imp_dbh->unicode = SvOK (valuesv) && SvTRUE (valuesv) ? 1 : 0;
if (ftp == SQLNUMERIC && fln > 0 && fln <= 4)
ftp = SQLSMINT;
f->ftp = ftp;
f->fln = fln;
f->fpr = fpr;
f->fic = fic;
f->fsc = fsc;
f->fnl = fnl;
f->val = &PL_sv_undef;
st_dbg (5, imp_sth, " Field %3d: ", fix);
st_dbg (6, imp_sth, "[%02X %02X %02X %02X %02X]",
(unsigned char)ftp, fln, fpr, fsc, fic);
st_dbg (5, imp_sth, "\n");
}
return (num_params);
} /* dbd_prm_describe */
int dbd_st_prepare (SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs) {
dTHX;
SV *dbh = (SV *)DBIc_PARENT_H (imp_sth);
D_imp_dbh_from_sth;
unless (DBIc_ACTIVE (imp_dbh))
return (0);
if (strlen (statement) >= MAX_SQL_LEN) {
warn ("DBD::Unify::st_prepare (\"%.40s ...\") statement too long",
statement);
return (0);
}
unless (imp_sth->id = new_sth_id (dbh))
return (0);
unless (use_sth_id (dbh, imp_dbh->id, imp_sth->id))
return (0);
if ((imp_sth->statement = (char *)malloc (strlen (statement) + 2)))
(void)strcpy (imp_sth->statement, statement);
imp_sth->stat = 0;
imp_sth->dbd_verbose = dbd_verbose;
imp_sth->fld = (imp_fld_t *)0;
imp_sth->prm = (imp_fld_t *)0;
imp_sth->unicode = imp_dbh->unicode;
if (attribs) {
SV **svp;
DBD_ATTRIB_GET_IV (attribs, "dbd_verbose", 11, svp, imp_sth->dbd_verbose);
DBD_ATTRIB_GET_IV (attribs, "uni_verbose", 11, svp, imp_sth->dbd_verbose);
}
st_dbg (3, imp_sth, "DBD::Unify::st_prepare %s (\"%s\")\n", u_sql_nm, statement);
dbd_st_diaper (imp_dbh, imp_sth);
DBIc_IMPSET_on (imp_sth);
EXEC SQL
ALLOCATE :c_sql_nm
CURSOR FOR :u_sql_nm;
if (SQLCODE == -2061) /* Cannot deallocate allocated cursor, so */
SQLCODE = 0; /* re-use it (it'll be the same context) */
st_dbg (4, imp_sth, " After allocate, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (0);
imp_sth->stat |= ST_STAT_ALLOCC;
(void)strcpy (u_sql_st, statement);
EXEC SQL
PREPARE :u_sql_nm
FROM :u_sql_st;
st_dbg (4, imp_sth, " After prepare, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (0);
imp_sth->stat |= ST_STAT_ALLOCP;
EXEC SQL
ALLOCATE SQL DESCRIPTOR :o_sql_nm
WITH MAX 128;
st_dbg (4, imp_sth, " After allocate, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (0);
imp_sth->stat |= ST_STAT_ALLOCO;
EXEC SQL
DESCRIBE OUTPUT :u_sql_nm
USING SQL DESCRIPTOR :o_sql_nm;
st_dbg (4, imp_sth, " After describe, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (0);
EXEC SQL
GET SQL DESCRIPTOR :o_sql_nm
:n_sql_st = COUNT;
st_dbg (4, imp_sth, " After count, sqlcode = %d, count = %d\n", SQLCODE, n_sql_st);
unless (sqlError (sth))
return (0);
DBIc_NUM_FIELDS (imp_sth) = n_sql_st;
dbd_fld_describe (dbh, imp_sth, n_sql_st);
/* Check for positional parameters */
{ register char *src = statement;
auto int in_lit = 0; /* inside "..." */
auto int in_str = 0; /* inside '...' */
auto int in_cmt = 0; /* inside comment */
while (*src) {
if (*src == '"' && !in_str && !in_cmt)
in_lit = ~in_lit;
else
if (*src == '\'' && !in_lit && !in_cmt)
in_str = ~in_str;
else
if (*src == '/' && src[1] == '*' && !in_lit && !in_str)
in_cmt = 1;
else
if (in_cmt && *src == '*' && src[1] == '/')
in_cmt = 0;
if ((*src == '?') && !in_lit && !in_str && !in_cmt)
DBIc_NUM_PARAMS (imp_sth)++;
src++;
}
if (DBIc_ACTIVE (imp_sth) && imp_sth->stat & ST_STAT_OPEN) { /* Re-execute */
EXEC SQL
CLOSE :c_sql_nm;
st_dbg (4, imp_sth, " After close, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (0);
imp_sth->stat &= ~ST_STAT_OPEN;
}
if (DBIc_NUM_FIELDS (imp_sth) == 0) {
/* non-select statement: just execute it */
st_dbg (3, imp_sth, "DBD::Unify::st_execute - non-select (<= %d, => %d)\n",
DBIc_NUM_FIELDS (imp_sth), DBIc_NUM_PARAMS (imp_sth));
if (DBIc_NUM_PARAMS (imp_sth) > 0) {
EXEC SQL
EXECUTE :u_sql_nm
USING SQL DESCRIPTOR :i_sql_nm;
}
else {
EXEC SQL
EXECUTE :u_sql_nm;
}
st_dbg (4, imp_sth, " After execute, sqlcode = %d (=> %d)\n",
SQLCODE, DBIc_NUM_PARAMS (imp_sth));
return (sqlError (sth) ? dbd_st_rows (sth, imp_sth) : -2);
}
if (DBIc_NUM_PARAMS (imp_sth) > 0) {
EXEC SQL
OPEN :c_sql_nm
USING SQL DESCRIPTOR :i_sql_nm;
}
else {
EXEC SQL
OPEN :c_sql_nm;
}
st_dbg (4, imp_sth, " After open, sqlcode = %d (=> %d)\n",
SQLCODE, DBIc_NUM_PARAMS (imp_sth));
unless (sqlError (sth))
return (0);
imp_sth->stat |= ST_STAT_OPEN;
DBIc_ACTIVE_on (imp_sth);
return (1);
} /* dbd_st_execute */
AV *dbd_st_fetch (SV *sth, imp_sth_t *imp_sth) {
dTHX;
int num_fields, i;
AV *av;
SV *dbh = (SV *)DBIc_PARENT_H (imp_sth);
D_imp_dbh_from_sth;
unless (use_sth_id (dbh, imp_dbh->id, imp_sth->id))
return (NULL);
st_dbg (3, imp_sth, "DBD::Unify::st_fetch %s\n", u_sql_nm);
unless (DBIc_ACTIVE (imp_sth)) {
error (sth, -7, "fetch without open cursor");
return (NULL);
}
/* In the next E/SQL a statement like
* "select code from table where field SHLIKE 'v_ab*'"
* will dump core in sqldfch ()
* affirmed for 6.3AB and 6.3BE
*/
EXEC SQL
FETCH :c_sql_nm
USING SQL DESCRIPTOR :o_sql_nm;
av = DBIc_DBISTATE (imp_sth)->get_fbav (imp_sth);
num_fields = AvFILL (av) + 1;
st_dbg (4, imp_sth, " Fetched sqlcode = %d, fields = %d\n",
SQLCODE, num_fields);
if (SQLCODE == UEEOSCN || SQLCODE == -UEEOSCN) {
st_dbg (4, imp_sth, " Fetch done (end of scan)\n");
(void)dbd_st_finish (sth, imp_sth);
return (NULL);
}
unless (sqlError (sth))
return (NULL);
unless (av_len (av) + 1 == num_fields) {
int ro = SvREADONLY (av);
if (ro)
SvREADONLY_off (av);
for (i = av_len (av) + 1; i < num_fields; i++)
av_store (av, i, newSV (0));
if (ro)
SvREADONLY_on (av);
}
unless (imp_sth->fld || dbd_fld_describe (dbh, imp_sth, num_fields)) {
croak ("Describe failed during %s->FETCH ()", SvPV_nolen (sth));
return (NULL);
}
for (fix = 1; fix <= num_fields; fix++) {
auto imp_fld_t *f = &imp_sth->fld[fix - 1];
auto SV *sv = AvARRAY (av)[fix - 1];
SvREADONLY_off (sv);
(void)strcpy (fnm, f->fnm);
fln = f->fln;
ftp = f->ftp;
fln = f->fln;
fpr = f->fpr;
fsc = f->fsc;
fnl = f->fnl;
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fic = INDICATOR;
st_dbg (4, imp_sth, " After get, sqlcode = %d\n", SQLCODE);
( run in 0.819 second using v1.01-cache-2.11-cpan-39bf76dae61 )