Re: DBD::Oracle, Support binding of integers so they are returned as IVs
Tim Bunce <[email protected]>
| Newsgroups | gmane.comp.lang.perl.modules.dbi.sybase.devel |
|---|---|
| Message-ID | <[email protected]> |
On Mon, Nov 09, 2009 at 05:05:11PM +0000, Martin Evans wrote:
> Martin Evans wrote:
> >>
> >> +/* Convert a simple string representation of a value into a more specific
> >> + * perl type based on an sql_type value.
> >> + * The semantics of SQL standard TYPE values are interpreted _very_ loosely
> >> + * on the basis of "be liberal in what you accept and let's throw in some
> >> + * extra semantics while we're here" :)
> >> + * Returns:
> >> + * -1: sv is undef or doesn't
> >> + * 0: sv couldn't be converted to requested (strict) type
> >> + * 1: sv was handled without a problem
> >> + */
> >> +int
> >> +post_fetch_sv(pTHX_ SV *h, imp_xxh_t *imp_xxh, SV *sv, int sql_type, U32 flags, void *v)
> >> +{
> >> + int discard_pv = 0;
> >> +
> >> + /* do nothing for undef (NULL) or non-string values */
> >> + if (!sv || !SvPOK(sv))
> >> + return -1;
> >> +
> >> + switch(sql_type) {
> >> +
> >> + /* caller would like IV (but may get UV or NV) */
> >> + /* will warn if not numeric. return 0 on overflow */
> >> + case SQL_SMALLINT:
> >> + discard_pv = 1;
> >> + case SQL_INTEGER:
> >> + sv_2iv(sv); /* is liberal, may return SvIV, SvUV, or SvNV */
> >> + if (SvNOK(sv)) { /* suspicious */
> >> + NV nv = SvNV(sv);
> >> + /* ignore NV set just to preserve digits after the decimal place */
> >> + /* just complain if the value won't fit in an IV or NV */
> >> + if (nv > UV_MAX || nv < IV_MIN)
> >> + return 0;
> >> + }
> >> + break;
> >> +
> >> + /* caller would like SvNOK/SvIOK true if the value is a number */
> >> + /* will warn if not numeric */
> >> + case SQL_FLOAT:
> >> + discard_pv = 1;
> >> + case SQL_DOUBLE:
> >> + sv_2nv(sv);
> >> + break;
> >> +
> >> + /* caller would like IV else UV else NV */
> >> + /* else no error and sv is untouched */
> >> + case SQL_NUMERIC:
> >> + discard_pv = 1;
> >> + case SQL_DECIMAL: {
> >> + UV uv;
> >> + /* based on the code in perl's toke.c */
> >> + int flags = grok_number(SvPVX(sv), SvCUR(sv), &uv);
> >> +
> >> + if (flags == IS_NUMBER_IN_UV) { /* +ve int */
> >> + if (uv <= IV_MAX) /* prefer IV over UV */
> >> + sv_2iv(sv);
> >> + else sv_2uv(sv);
> >> + }
> >> + else if (flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG)
> >> + && uv <= IV_MAX
> >> + ) {
> >> + sv_2iv(sv);
> >> + }
> >> + else if (flags) /* is numeric */
> >> + sv_2nv(sv);
> >> + }
> >> + break;
> >> +
> >> +#if 0 /* XXX future possibilities */
> >> + case SQL_BIGINT: /* use Math::BigInt if too large for IV/UV */
> >> +#endif
> >> + default:
> >> + return 0; /* value unchanged */
> >> + }
> >> +
> >> + if (discard_pv /* caller wants string buffer discarded */
> >> + && SvNIOK(sv) /* we set a numeric value */
> >> + && SvPVX(sv) && SvLEN(sv) /* we have a buffer to discard */
> >> + ) {
> >> + Safefree(SvPVX(sv));
> >> + SvPVX(sv) = NULL;
> >> + SvPOK_off(sv);
> >> + }
> >> + return 1;
> >> +}
> There was an omission in my addition to Tim's example as I forgot to
> change DBISTATE_VERSION.
Thanks. Though that's less important than it was now there's also
DBIXS_REVISION (in dbixs_rev.h) that automatically tracks the svn
revsion number.
> I've implemented this as it stands in DBD::Oracle and it seems to work
> out ok and certainly where I was wanting to go (and further).
Ok.
> My own feeling is that if someone asks for something to be bound as an
> SQL_INTEGER and it cannot due to over/under flow this should be an error
> and that is how I've implemented it.
The return value of post_fetch_sv() is meant to allow drivers to
report an error.
I thought about making post_fetch_sv() itself call DBIh_SET_ERR_* to
report an error but opted to avoid that because, to generate a good
error more info would need to be passed, like the column number.
On the other hand, if post_fetch_sv() doesn't do it then there's a
greater risk of inconsistency between the drivers.
> Perhaps it could have been one of those informationals as the sv is
> unchanged and still usable but it is not in the requested format so
> I'd class that an error.
Perhaps we should have $sth->bind_col(..., { LooselyTyped => 1 });
to allow for those who don't want an error if the type doesn't fit.
That certainly feels better than overloading SQL_INTEGER vs SQL_NUMERIC
to achieve the same effect!
> However, I have
> a very small concern for people who might have been binding columns with
> a type but no destination SV but their DBD did nothing about it (which I
> believe is all DBDs up to now). For me, I didn't leave that code in and
> just documented it as:
>
> # I was hoping the following would work (according to DBI, it
> # might) to ensure the a, b and c
> # columns are returned as integers instead of strings saving
> # us from having to add 0 to them below. It does not with
> # DBD::Oracle.
> # NOTE: you don't have to pass a var into bind_col to receive
> # the column data as it works on the underlying column and not
> # just a particular bound variable.
> #$cursor->bind_col(4, undef, { TYPE => SQL_INTEGER });
> #$cursor->bind_col(5, undef, { TYPE => SQL_INTEGER });
> #$cursor->bind_col(10, undef, { TYPE => SQL_INTEGER });
>
> but if those last 3 lines were left uncommented they would have ended up
> a noop before but not now. However, I'd be surprised if anyone was
> really doing that as it did nothing.
Does anyone know of any drivers that pay any attention to the type param
of bind_column?
We could make it default to issuing a warning on overflow, and have
attributes to specify either an error or ignore.
> I think a MinMemory attribute would be ok but I'd use it as in most of
> my cases I am retrieving the whole result-set in one go and it can be
> very large. How would post_fetch_sv know this attribute?
Via the flags argument.
> What was the intention of "void *v" argument at the end of post_fetch_sv?
Planning for an uncertain future.
After mulling it over some more, and looking at ODBC's SQLBindCol (which
takes a C type, not an SQL type) I've decided to err on the simple side.
I've appended a patch for review.
Tim.
Index: DBI.xs
===================================================================
--- DBI.xs (revision 13478)
+++ DBI.xs (working copy)
@@ -78,6 +78,7 @@
static int set_err_char _((SV *h, imp_xxh_t *imp_xxh, const char *err_c, IV err_i, const char *errstr, const char *state, const char *method));
static int set_err_sv _((SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method));
static int quote_type _((int sql_type, int p, int s, int *base_type, void *v));
+static int sql_type_cast_svpv _((pTHX_ SV *h, imp_xxh_t *imp_xxh, SV *sv, int sql_type, U32 flags, void *v));
static I32 dbi_hash _((const char *string, long i));
static void dbih_dumphandle _((pTHX_ SV *h, const char *msg, int level));
static int dbih_dumpcom _((pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level));
@@ -434,11 +435,12 @@
DBIS->get_fbav = dbih_get_fbav;
DBIS->make_fdsv = dbih_make_fdsv;
DBIS->neat_svpv = neatsvpv;
- DBIS->bind_as_num = quote_type;
+ DBIS->bind_as_num = quote_type; /* XXX deprecated */
DBIS->hash = dbi_hash;
DBIS->set_err_sv = set_err_sv;
DBIS->set_err_char= set_err_char;
DBIS->bind_col = dbih_sth_bind_col;
+ DBIS->sql_type_cast_svpv = sql_type_cast_svpv;
/* Remember the last handle used. BEWARE! Sneaky stuff here! */
@@ -1696,6 +1698,8 @@
(void)s;
(void)t;
(void)v;
+ /* looks like it's never been used, and doesn't make much sense anyway */
+ warn("Use of DBI internal bind_as_num/quote_type function is deprecated");
switch(sql_type) {
case SQL_INTEGER:
case SQL_SMALLINT:
@@ -1714,6 +1718,95 @@
}
+/* Convert a simple string representation of a value into a more specific
+ * perl type based on an sql_type value.
+ * The semantics of SQL standard TYPE values are interpreted _very_ loosely
+ * on the basis of "be liberal in what you accept and let's throw in some
+ * extra semantics while we're here" :)
+ * Returns:
+ * -1: sv is undef, unchanged
+ * -2: sql_type isn't handled, value unchanged
+ * 0: sv couldn't be converted to requested (strict) type
+ * 1: sv was handled without a problem
+ */
+#define DBIstcf_DISCARD_PV 0x0001
+#define DBIstcf_STRICT 0x0002
+
+int
+sql_type_cast_svpv(pTHX_ SV *h, imp_xxh_t *imp_xxh, SV *sv, int sql_type, U32 flags, void *v)
+{
+
+ /* do nothing for undef (NULL) or non-string values */
+ if (!sv || !SvOK(sv))
+ return -1;
+
+ switch(sql_type) {
+
+ case SQL_INTEGER:
+ /* sv_2iv is liberal, may return SvIV, SvUV, or SvNV */
+ sv_2iv(sv);
+ /* if strict, complain if SvNOK set because value is out of range
+ * for IV/UV, or if SvIOK is not set because it's not numeric (in which
+ * case perl would have warn'd already if -w or warnings are in effect)
+ */
+ if (flags & DBIstcf_STRICT && (SvNOK(sv) || !SvIOK(sv))) {
+ return 0;
+ }
+ break;
+
+ case SQL_DOUBLE:
+ sv_2nv(sv);
+ /* if strict, complain if !SvNOK because value is not numeric
+ * (perl would have warn'd already if -w or warnings are in effect)
+ */
+ if (flags & DBIstcf_STRICT && !SvNOK(sv)) {
+ return 0;
+ }
+ break;
+
+ /* caller would like IV else UV else NV */
+ /* else no error and sv is untouched */
+ case SQL_NUMERIC: {
+ UV uv;
+ /* based on the code in perl's toke.c */
+ int flags = grok_number(SvPVX(sv), SvCUR(sv), &uv);
+ if (flags == IS_NUMBER_IN_UV) { /* +ve int */
+ if (uv <= IV_MAX) /* prefer IV over UV */
+ sv_2iv(sv);
+ else sv_2uv(sv);
+ }
+ else if (flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG)
+ && uv <= IV_MAX
+ ) {
+ sv_2iv(sv);
+ }
+ else if (flags) /* is numeric */
+ sv_2nv(sv);
+ }
+ else if (flags & DBIstcf_STRICT)
+ return 0; /* not numeric */
+ break;
+
+#if 0 /* XXX future possibilities */
+ case SQL_BIGINT: /* use Math::BigInt if too large for IV/UV */
+#endif
+ default:
+ return -2; /* not a recognised SQL TYPE, value unchanged */
+ }
+
+ if (flags & DBIstcf_DISCARD_PV /* caller wants string buffer discarded */
+ && SvNIOK(sv) /* we set a numeric value */
+ && SvPVX(sv) && SvLEN(sv) /* we have a buffer to discard */
+ ) {
+ Safefree(SvPVX(sv));
+ SvPVX(sv) = NULL;
+ SvPOK_off(sv);
+ }
+ return 1;
+}
+
+
+
/* --- Generic Handle Attributes (for all handle types) --- */
static int
Index: DBIXS.h
===================================================================
--- DBIXS.h (revision 13478)
+++ DBIXS.h (working copy)
@@ -392,7 +392,7 @@
struct dbistate_st {
-#define DBISTATE_VERSION 94 /* Must change whenever dbistate_t does */
+#define DBISTATE_VERSION 95 /* Must change whenever dbistate_t does */
/* this must be the first member in structure */
void (*check_version) _((const char *name,
@@ -417,7 +417,7 @@
SV * (*get_attr_k) _((SV *h, SV *keysv, int dbikey));
AV * (*get_fbav) _((imp_sth_t *imp_sth));
SV * (*make_fdsv) _((SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name));
- int (*bind_as_num) _((int sql_type, int p, int s, int *t, void *v));
+ int (*bind_as_num) _((int sql_type, int p, int s, int *t, void *v)); /* XXX deprecated */
I32 (*hash) _((const char *string, long i));
SV * (*preparse) _((SV *sth, char *statement, IV ps_return, IV ps_accept, void *foo));
@@ -432,9 +432,10 @@
IO *logfp_ref; /* DAA keep ptr to filehandle for refcounting */
+ int (*cast_svpv) _((SV *h, imp_xxh_t *imp_xxh, SV *sv, int sql_type, U32 flags, void *v));
/* WARNING: Only add new structure members here, and reduce pad2 to keep */
/* the memory footprint exactly the same */
- void *pad2[4];
+ void *pad2[3];
};
/* macros for backwards compatibility */
Index: dbixs_rev.h
===================================================================
--- dbixs_rev.h (revision 13478)
+++ dbixs_rev.h (working copy)
@@ -1,4 +1,4 @@
-/* Mon Nov 2 22:44:58 2009 */
-/* Mixed revision working copy (13455M:13465) */
+/* Fri Nov 6 23:01:13 2009 */
+/* Mixed revision working copy (13455M:13466) */
/* Code modified since last checkin */
#define DBIXS_REVISION 13455