DBD-Unify
view release on metacpan or search on metacpan
dbg (3, "DBD::Unify::db_login: dbname: %s\n", dbname);
/* CONNECT [db_name];
*
* db_name: [[dbhost]:[dbuser]:][dbpath] [dbname]
* $DBHOST, $DBUSER, DBPATH, $DBNAME
*
* Users are implicitly checked by grants
*
* SET CURRENT SCHEMA TO 'USCHEMA';
*
* $USCHEMA (passed as $auth)
*/
opt = dbname;
/* look for options in dbname. Syntax: dbname;options */
while (*opt && *opt != ';')
++opt;
if (*opt == ';') {
*opt = 0; /* terminate dbname */
opt++; /* point to options */
}
if (user && *user && *user != '/') {
/* we have a username */
dbg (4, " user = '%s', opt = '%s' (ignored)\n", user, opt);
}
if (dbname && *dbname) {
(void)sprintf (statement, "DBPATH=%s", dbname);
(void)putenv (statement);
}
unless (pgm) {
/* Register program to monitor system, must be done BEFORE connect */
USTATUS ustatus;
pgm = basename (SvPV_nolen (get_sv ("0", 0)));
(void)uinimsg (pgm, &ustatus);
dbg (4, " After uinimsg ('%s'), status = %ld\n", pgm, ustatus);
}
EXEC SQL
CONNECT;
dbg (4, " After connect, sqlcode = %d\n", SQLCODE);
/* Problem number 22960: 2nd Connect to same database fails */
if (SQLCODE == -254) SQLCODE = 0;
unless (sqlError (dbh))
return (0);
DBIc_IMPSET_on (imp_dbh); /* imp_dbh set up now */
DBIc_ACTIVE_on (imp_dbh); /* call disconnect before freeing */
DBIc_set (imp_dbh, DBIcf_AutoCommit, 0);
DBIc_set (imp_dbh, DBIcf_ChopBlanks, 1);
imp_dbh->id = n_dbh++;
imp_dbh->children = (imp_sth_t **)0;
imp_dbh->nchildren = 0;
imp_dbh->unicode = 0;
unless (auth && *auth)
auth = getenv ("USCHEMA");
if ((!user || !*user) && auth && *auth) {
(void)sprintf (statement, "set current schema to \"%s\"", auth);
dbg (3, " %s\n", statement);
EXEC SQL
EXECUTE IMMEDIATE :statement;
dbg (4, " After schema, sqlcode = %d\n", SQLCODE);
unless (sqlError (dbh))
return (0);
}
unless (sth_id_on || (sth_id_on = (byte *)calloc (n_sth_id, 8))) {
error (dbh, errno, "Cannot allocate space for STH's");
return (0);
}
return (1);
} /* dbd_db_login */
static char *u_err (USTATUS s) {
USTATUS status;
static char e[2048];
char *msg = ufchmsg (s, &status);
sprintf (e, "%04d: %s", s, msg ? msg : "Unknown error");
return (e);
} /* u_err */
/* Fetch DB info and store in hash
%db{AUTH}[4] = { = $db{s}{"SYS"}
AID => 4,
NAME => "SYS,
TABLES => [ 77, ...],
],
$db{TABLE}[77] = { = $db{t}{"SYS.HASH_INDEXES"}
TID => 77,
NAME => "HASH_INDEXES",
OPTIONS => 0x12,
DIRECTKEY => 0,
SCATTERED => 0,
FIXEDSIZE => 0,
PKEYED => 0,
COLUMNS => [ 323, ...],
},
$db{COLUMN}[323] = {
TID => 77,
TNAME => "
CID => 323,
NAME => "OWNR",
TYPE => 5, # CHAR
LENGTH => 18,
SCALE => 0,
NULLABLE => 0,
DSP_LEN => 18,
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;
return (TRUE);
}
if ((kl == 13 && strEQ (key, "uni_scanlevel")) ||
(kl == 9 && strEQ (key, "ScanLevel"))) {
auto int val = SvIV (valuesv);
dbg (3, "DBD::Unify::dbd_db_STORE (ScanLevel = %d)\n", val);
if (val < 1 || val > 16)
return (FALSE);
(void)sprintf (u_sql_do, "set transaction scan level %d", val);
EXEC SQL
EXECUTE IMMEDIATE :u_sql_do;
dbg (4, " After SCANLVL, sqlcode = %d\n", SQLCODE);
unless (sqlError (dbh))
return (FALSE);
return (TRUE);
}
return (FALSE);
} /* dbd_db_STORE_attrib */
SV *dbd_db_FETCH_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv) {
dTHX;
STRLEN kl;
char *key = SvPV (keysv, kl);
unless (DBIc_ACTIVE (imp_dbh))
return (NULL);
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose")))
return (newSViv (dbd_verbose));
if (kl == 11 && strEQ (key, "uni_unicode"))
return (newSViv (imp_dbh->unicode));
if (kl == 10 && strEQ (key, "AutoCommit"))
return (newSVsv (boolSV (0)));
return (NULL);
} /* dbd_db_FETCH_attrib */
/* ##### Unify ST stuff #################################################### */
static short new_sth_id (SV *dbh) {
register short i;
register short b;
for (i = 0; i < n_sth_id; i++) {
for (b = 0; b < 7; b++) {
unless (sth_id_on[i] & (1 << b)) {
sth_id_on[i] |= (1 << b);
return (i * 8 + b + 1);
}
}
}
i = n_sth_id + 4;
if ((sth_id_on = realloc (sth_id_on, i * 8))) {
b = n_sth_id * 8 + 1;
sth_id_on[n_sth_id++] = (byte)1;
sth_id_on[n_sth_id++] = (byte)0;
sth_id_on[n_sth_id++] = (byte)0;
sth_id_on[n_sth_id++] = (byte)0;
return (b);
}
error (dbh, errno, "Cannot allocate extra space for STH's");
return (0);
} /* new_sth_id */
static short clr_sth_id (SV *dbh, short id) {
if (id <= 0 || id > n_sth_id * 8) {
error (dbh, 0, "Cannot clr invalid statement ID");
return (0);
}
id--;
unless (sth_id_on[id / 8] & (1 << (id % 8))) {
error (dbh, 0, "Cannot clr statement ID already cleared (threading?)");
return (0);
}
sth_id_on[id / 8] &= ~(1 << (id % 8));
return (1);
} /* set_sth_id */
static int use_sth_id (SV *dbh, short dbhid, short id) {
if (id <= 0 || id > n_sth_id * 8) {
error (dbh, 0, "Cannot use invalid statement ID");
return (0);
}
id--;
unless (sth_id_on[id / 8] & (1 << (id % 8))) {
error (dbh, 0, "Cannot use statement ID");
return (0);
}
if (dbhid < 0 || dbhid > 99999) {
error (dbh, 0, "Cannot use DBH ID");
return (0);
:ftp = TYPE,
:fln = LENGTH,
:fpr = PRECISION,
:fic = INDICATOR,
:fsc = SCALE,
:fnl = NULLABLE/*, Core dump on OSF/1 & Solaris
:fnm = NAME */;
unless (sqlError (dbh))
return (0);
i = sizeof (fnm);
while (i && (!fnm[i - 1] || fnm[i - 1] == ' '))
i--;
fnm[i] = (char)0;
(void)strncpy (f->fnm, fnm, sizeof (fnm));
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 */
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);
unless (sqlError (sth))
return (NULL);
f->fic = fic;
st_dbg (4, imp_sth, " Field %3d: ", fix);
st_dbg (5, imp_sth, "[%02X %02X %02X %02X %02X] ",
(unsigned char)ftp, fln, fpr, fsc, fic);
st_dbg (4, imp_sth, "%-.8s: ", fnm);
if (fic == -1) { /* NULL */
(void)SvOK_off (sv);
st_dbg (4, imp_sth, "NULL ==\n");
continue;
}
switch (ftp) {
case SQLBYTE:
case SQLCHAR:
st_dbg (4, imp_sth, "%s%6d: ", ftp == SQLBYTE ? "BYTE" : "CHAR", fln);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdC = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
i = fln;
if (DBIc_has (imp_sth, DBIcf_ChopBlanks)) {
while (i && (!fdC[i - 1] || fdC[i - 1] == ' '))
i--;
}
fdC[i] = (char)0;
sv_setpvn (sv, fdC, i);
if (imp_sth->unicode && is_utf8_string ((U8 *)fdC, i)) {
st_dbg (5, imp_sth, "is UTF8 ");
SvUTF8_on (sv);
}
st_dbg (4, imp_sth, "(%d) '%s'", i, SvPVX (sv));
break;
case SQLFLOAT:
st_dbg (4, imp_sth, "FLOAT %2d.%1d.%02d: ", fln, fpr, fsc);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdF = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
#ifdef SET_PV_FOR_NV
(void)sprintf (fdC, "%.*f", fsc, fdF);
sv_setpvn (sv, fdC, strlen (fdC));
#endif
sv_setnv (sv, (double)fdF);
st_dbg (4, imp_sth, "%lf", SvNV (sv));
break;
case SQLCURRENCY:
case SQLREAL: /* fpr = 32 */
case SQLDBLPREC: /* fpr = 64 */
st_dbg (4, imp_sth, "DOUBL %1d.%02d.%02d: ", fln, fpr, fsc);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdD = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
#ifdef SET_PV_FOR_NV
(void)sprintf (fdC, "%f", fdD);
{ char *s = strchr (fdC, '.');
if (s) { /* ".00000" => "", ".125000" => ".125" */
int i = strlen (s);
while (i > 1 && s[i - 1] == '0') s[--i] = (char)0;
if (s[--i] == '.') s[i] = (char)0;
}
}
sv_setpvn (sv, fdC, strlen (fdC));
#endif
sv_setnv (sv, fdD);
st_dbg (4, imp_sth, "%g (%s)", SvNV (sv), fdC);
break;
case SQLAMOUNT:
st_dbg (4, imp_sth, "AMNT %d.%d: ", fpr, fsc);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdF = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
#ifdef SET_PV_FOR_NV
(void)sprintf (fdC, "%.*f", fsc, fdF);
break;
case SQLHDATE:
st_dbg (4, imp_sth, "HDATE %2d: ", fpr);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdHDT = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
st_dbg (4, imp_sth, "(%ld) ", (long)fdHDT);
if (ldtoa (fdHDT, fdC))
croak ("DBD::Unify::st_fetch: ldtoa (%d) failed", fdHDT);
sv_setpvn (sv, fdC, strlen (fdC));
st_dbg (4, imp_sth, "(%d) '%s'", strlen (fdC), SvPVX (sv));
/*sv_setiv (sv, (long)fdHDT);*/
/*st_dbg (4, imp_sth, "%ld", SvIV (sv));*/
break;
case SQLDATETIME:
st_dbg (4, imp_sth, "DATETIME %2d: ", fpr);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdDTTM = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
sv_setpvn (sv, fdDTTM, strlen(fdDTTM));
st_dbg (4, imp_sth, "(%d) '%s'", strlen(fdDTTM), SvPVX (sv));
break;
case SQLTEXT: {
auto char *s;
st_dbg (4, imp_sth, "TEXT %2d: ", ftp);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdB = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
i = fdB.curlen;
s = fdB.dataptr;
if (i && s) {
#ifdef CHOP_BLANKS_TEXT
if (DBIc_has (imp_sth, DBIcf_ChopBlanks)) {
while (i && (!s[i - 1] || s[i - 1] == ' '))
i--;
}
s[i] = (char)0;
#endif
}
else {
s = "";
i = 0;
}
sv_setpvn (sv, s, i);
if (imp_sth->unicode && is_utf8_string ((U8 *)s, i)) {
st_dbg (5, imp_sth, "is UTF8 ");
SvUTF8_on (sv);
}
st_dbg (4, imp_sth, "(%d) '%s'", i, SvPVX (sv));
break;
}
case SQLBINARY: {
auto char *s;
st_dbg (4, imp_sth, "BINARY %2d: ", ftp);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdX = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
i = fdX.curlen;
s = fdX.dataptr;
unless (i && s) {
s = "";
i = 0;
}
sv_setpvn (sv, s, i);
st_dbg (4, imp_sth, "(%d) %8X ...", i, SvPVX (sv));
break;
}
case SQLNUMERIC:
case SQLDECIMAL:
case SQLINTEGER:
st_dbg (4, imp_sth, "NUMERIC %2d: ", fpr);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdL = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
st_dbg (4, imp_sth, "(%ld) ", fdL);
sv_setiv (sv, fdL);
st_dbg (4, imp_sth, "%ld", SvIV (sv));
break;
case SQLSMINT:
st_dbg (4, imp_sth, "NUMERIC %2d: ", fpr);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
VALUE :fix
:fdS = DATA;
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
st_dbg (4, imp_sth, "(%d) ", fdS);
sv_setiv (sv, (int)fdS);
st_dbg (4, imp_sth, "%ld", SvIV (sv));
break;
case SQLNOTYPE:
if (SQLCODE == -2124) SQLCODE = 0;
unless (sqlError (sth))
return;
imp_sth->stat &= ~ST_STAT_ALLOCP;
}
st_dbg (7, imp_sth, " destroy stat");
if (imp_sth->stat)
warn ("DBD::Unify::st_free: Handle stat not clear: 0x%02X\n", imp_sth->stat);
else {
clr_sth_id (dbh, imp_sth->id);
imp_sth->id = 0;
}
if (imp_sth->statement) {
(void)free (imp_sth->statement);
imp_sth->statement = (char *)0;
}
if (imp_sth->fld) {
(void)free (imp_sth->fld);
imp_sth->fld = (imp_fld_t *)0;
}
if (imp_sth->prm) {
(void)free (imp_sth->prm);
imp_sth->prm = (imp_fld_t *)0;
}
st_dbg (7, imp_sth, " destroy growup");
dbd_st_growup (imp_dbh, imp_sth);
st_dbg (7, imp_sth, " destroy impset\n");
if (DBIc_has (imp_sth, DBIcf_IMPSET))
DBIc_IMPSET_off (imp_sth);
st_dbg (3, imp_sth, "DBD::Unify::st 0x%08X 0x%04x 0x%04X 0x%08X 0x%08X 0x%08X\n",
imp_sth->com, imp_sth->id, imp_sth->stat, imp_sth->statement,
imp_sth->fld, imp_sth->prm);
st_dbg (3, imp_sth, "DBD::Unify::st destroyed\n");
} /* dbd_st_destroy */
int dbd_st_blob_read (SV *sth, imp_sth_t *imp_sth, int field,
long offset, long len, SV *destrv, long destoffset) {
dTHX;
NYI ("st_blob_read");
return (0);
} /* dbd_st_blob_read */
int dbd_st_STORE_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv) {
dTHX;
STRLEN kl;
char *key = SvPV (keysv, kl);
/*
st_dbg (4, imp_sth, "DBD::Unify::st_STORE (%s)->{%s}\n", imp_sth->name, key);
*/
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose"))) {
imp_sth->dbd_verbose = SvIV (valuesv);
dbg (2, "Set DBD_VERBOSE for STH = %d\n", dbd_verbose);
return (TRUE);
}
if (kl == 11 && strEQ (key, "uni_unicode")) {
imp_sth->unicode = SvOK (valuesv) && SvTRUE (valuesv) ? 1 : 0;
return (TRUE);
}
return (FALSE); /* no values to store */
} /* dbd_st_STORE_attrib */
int uni2sql_type (SQLCOLTYPE t) {
/* see also perl5/site_perl/5.10.1/x86_64-linux/auto/DBI/dbi_sql.h
* and $UNIFY/../include/sqle_usr.h */
switch (t) { /* ANSI/ODBC Column type DBI */
case SQLNOTYPE: return ( 0); /* - */
case SQLCHAR: return ( 1); /* character, char SQL_CHAR */
case SQLNUMERIC: return ( 2); /* numeric SQL_NUMERIC */
case SQLDECIMAL: return ( 3); /* decimal, dec SQL_DECIMAL */
case SQLCURRENCY:return ( 3); /* currency SQL_DECIMAL */
case SQLINTEGER: return ( 4); /* integer, int SQL_INTEGER */
case SQLSMINT: return ( 5); /* smallint SQL_SMALLINT */
case SQLFLOAT: return ( 6); /* float SQL_FLOAT */
case SQLAMOUNT: return ( 6); /* amount - */
case SQLREAL: return ( 7); /* real SQL_REAL */
case SQLHUGEAMT: return ( 7); /* huge amount - */
case SQLDBLPREC: return ( 8); /* double precision SQL_DOUBLE */
case SQLDATE: return ( 9); /* date SQL_DATE */
case SQLHDATE: return ( 9); /* huge date SQL_DATE */
case SQLSMTIME: return (10); /* time SQL_TIME */
case SQLDATETIME:return (11); /* datetime SQL_TIMESTAMP */
/* 12 SQL_VARCHAR */
/* 16 SQL_BOOLEAN */
case SQLTEXT: return (-1); /* text SQL_LONGVARCHAR */
case SQLBYTE: return (-2); /* byte SQL_BINARY */
case SQLBINARY: return (-3); /* binary SQL_VARBINARY */
/* -4 SQL_LONGVARBINARY */
case SQLINT64: return (-5); /* huge integer SQL_BIGINT */
/* -6 SQL_TINYINT */
/* -7 SQL_BIT */
}
dbg (4, "No ANSI support for type %d\n", t);
/* No (official) support for
* -18 SQLAMT64 CURRENCY, GIANT AMOUNTS
* -17 SQLINT64 HUGE INTEGER (on 32bit systems)
*/
return (0); /* - SQL_UNKNOWN_TYPE */
} /* uni2sql_type */
SV *dbd_st_FETCH_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv) {
dTHX;
STRLEN kl;
char *key = SvPV (keysv, kl);
int i, p;
SV *retsv = NULL;
int cacheit = TRUE;
if (kl == 13 && strEQ (key, "NUM_OF_PARAMS")) /* handled by DBI */
return (NULL);
unless (imp_sth->fld)
return (NULL);
i = DBIc_NUM_FIELDS (imp_sth);
p = DBIc_NUM_PARAMS (imp_sth);
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose"))) {
retsv = newSViv (imp_sth->dbd_verbose);
}
else
if (kl == 11 && strEQ (key, "uni_unicode")) {
retsv = newSViv (imp_sth->unicode);
}
else
if (kl == 4 && strEQ (key, "NAME")) {
AV *av = newAV ();
retsv = newRV_inc (sv_2mortal ((SV *)av));
while (--i >= 0)
av_store (av, i, newSVpv (imp_sth->fld[i].fnm, 0));
}
else
if (kl == 4 && strEQ (key, "TYPE")) {
AV *av = newAV ();
retsv = newRV_inc (sv_2mortal ((SV *)av));
while (--i >= 0)
av_store (av, i, newSViv (uni2sql_type (imp_sth->fld[i].ftp)));
}
else
if (kl == 8 && strEQ (key, "uni_type")) {
AV *av = newAV ();
retsv = newRV_inc (sv_2mortal ((SV *)av));
while (--i >= 0)
av_store (av, i, newSViv (imp_sth->fld[i].ftp));
}
else
if (kl == 9 && strEQ (key, "PRECISION")) {
AV *av = newAV ();
retsv = newRV_inc (sv_2mortal ((SV *)av));
while (--i >= 0)
av_store (av, i, newSViv (imp_sth->fld[i].ftp == 1
? imp_sth->fld[i].fln
: imp_sth->fld[i].fpr));
}
else
if (kl == 5 && strEQ (key, "SCALE")) {
AV *av = newAV ();
retsv = newRV (sv_2mortal ((SV *)av));
while (--i >= 0)
av_store (av, i, newSViv (imp_sth->fld[i].fsc));
}
else
if (kl == 8 && strEQ (key, "NULLABLE")) {
AV *av = newAV ();
retsv = newRV (sv_2mortal ((SV *)av));
while (--i >= 0) /* Completely unreliable */
av_store (av, i, newSViv (2 /* imp_sth->fld[i].fnl */));
}
else
if (kl == 10 && strEQ (key, "CursorName")) {
char c_nm[MAX_NM_LEN];
D_imp_dbh_from_sth;
(void)sprintf (c_nm, "c_sql_%05d_%06d", imp_dbh->id, imp_sth->id);
retsv = newSVpv (c_nm, 0);
}
else
if (kl == 11 && strEQ (key, "RowsInCache")) {
retsv = newSViv (0);
}
else
if (kl == 11 && strEQ (key, "ParamValues")) {
HV *hv = newHV ();
( run in 1.263 second using v1.01-cache-2.11-cpan-39bf76dae61 )