Thread is getting a bit long so I've snipped a lot of previous code.

Tim Bunce wrote:
> On Mon, Nov 09, 2009 at 05:05:11PM +0000, Martin Evans wrote:
>> Martin Evans wrote:
>>>>  

<first patch snipped>

> 
>> 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.

I agree and had already output an error containing 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.

I think we already have a level of inconsistency as some drivers already
return IVs without being asked for them. Also, number handling in each
database tends to differ quite a bit so I suspect the default may want
to differ per DBD.

>> 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.

I'm happy with that.

> That certainly feels better than overloading SQL_INTEGER vs SQL_NUMERIC
> to achieve the same effect!

agreed.

>> 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?

I did not find one when I was looking a few months ago.

> We could make it default to issuing a warning on overflow, and have
> attributes to specify either an error or ignore.

We could but I think most people would be happy with error or specifying
LooselyTyped. You either know you need LooselyTyped or not and if not
you can leave it off and if it errors then your data was not as you
thought and have to decide if your data is wrong or you need
LooselyTyped. I'd be concerned a warning might just get in the way.

>> 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.

As it turns out I /need/ MinMemory or SvPOKp(sv) returns true and that
ends up being a string again in JSON::XS. i.e., I needed the equivalent
of adding 0 to the sv which does this:

 perl -le 'use Devel::Peek;my $a = "5"; Dump($a); $a = $a + 0; Dump($a);'
SV = PV(0x8154b00) at 0x815469c
  REFCNT = 1
  FLAGS = (PADBUSY,PADMY,POK,pPOK)
  PV = 0x816fb48 "5"\0
  CUR = 1
  LEN = 4
SV = PVIV(0x8155b10) at 0x815469c
  REFCNT = 1
  FLAGS = (PADBUSY,PADMY,IOK,pIOK)
  IV = 5
  PV = 0x816fb48 "5"\0
  CUR = 1
  LEN = 4

as JSON::XS does:

if (SvPOKp (sv))
{
   .
}
else if (SvNOKp (sv))
{
   .
}
else if (SvIOKp (sv))
{
   I want this case.

Of course, I could argue with the JSON::XS maintainer for changing the
order but I don't hold out much hope of that changing.

>> What was the intention of "void *v" argument at the end of post_fetch_sv?
> 
> Planning for an uncertain future.

ok.

> 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.
> 

<new patch snipped>

There were a few small issues with the latest patch but it was obvious
what you meant so I have rectified them and made changes to my test
DBD::Oracle. This works rather nicely now.

At this stage I have the following changes and comments:

o patch as you supplied with minor corrections in DBI

  The only one I'm not 100% about is that:

    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) = Nullch; /* changed from NULL to Nullch */
         SvLEN(sv) = 0; /* <--- added this as it aborts without it */
         SvPOK_off(sv);
    }

  Without that line adding it always aborts if MinMemory=1 and there is
  more than one row.

o added dbd_st_bind_col to DDB::Oracle
  stores the requested type in fbh
  handles LooselyTyped and MinMemory and saves in fbh
  defaults to DBIstcf_STRICT if LooselyTyped not specified

  Comment: I thought DBIstcf_STRICT was a good default but others may
          not.
  Comment: DBIstcf_STRICT and DBIstcf_DISCARD_PV macros are not
available as symbols to a DBD at present so I'm using 1 and 2 in
DBD::Oracle. I wasn't sure where they'd go.

  Comment: I was not so keen on the attribute being LooselyTyped and the
macro being DBIstcf_STRICT as they have opposite meanings but I'm not
really bothered as LooselyTyped is all that is really going to be visible.

o oci8.c and dbd_st_fetch modified to call DBI's sql_type_cast_svpv and
errors when 0 (no strict conversion, with "over/under flow converting
column N to type N") and -2 (sql type unhandled, with "unsupported bind
type N for column N"). I don't need to think about undef in
DBD::Oracle's case as it is handled separately.

o test code using all this which demonstrates binding with a type works
and LoosleyTyped and MinMemory do as they should. Some of this will be a
little awkward to turn into a test that works for everyone as it needs
Devel::Peek.

What I haven't done or would appreciate feedback on:

o My test DBD::Oracle currently assumes DBI has sql_type_cast_svpv. What
is the usual way of deciding this - checking DBI version?

o macros for DBIstcf_STRICT and DBIstcf_DISCARD_PV - see above

o any documentation for DBI::DBD although I am happy to do so when you
are happy we have reached a consensus.

o any documentation for DBI - as above.

o I wouldn't mind someone else looking over the changes as although I
currently maintain DBD::ODBC I do not consider myself a DBI internals of
XS expert.

o Although my primary impetus for doing this is I need it in DBD::Oracle
I would plan to do something similar in DBD::ODBC once this stuff is
committed.

o I do not have a commit bit on DBD::Oracle so will pass the DBD::Oracle
changes to John when ready.

Thanks.

Here are the changes so far:

Index: DBI.xs
===================================================================
--- DBI.xs      (revision 13479)
+++ 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,13 +435,13 @@
     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!        */
     /* We want a handle reference but we don't want to increment        */
     /* the handle's reference count and we don't want perl to try       */
@@ -1696,6 +1697,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:
@@ -1713,7 +1716,100 @@
     return 1;
 }

+/* 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) = Nullch;
+         SvLEN(sv) = 0;
+         SvPOK_off(sv);
+    }
+    return 1;
+}
+
+
+
+
 /* --- Generic Handle Attributes (for all handle types) ---     */

 static int
Index: DBIXS.h
===================================================================
--- DBIXS.h     (revision 13479)
+++ 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));

@@ -431,10 +431,10 @@
     int         (*bind_col)     _((SV *sth, SV *col, SV *ref, SV
*attribs));

     IO *logfp_ref;      /* DAA keep ptr to filehandle for refcounting */
-
+    int         (*sql_type_cast_svpv) _((pTHX_ 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 13479)
+++ dbixs_rev.h (working copy)
@@ -1,4 +1,3 @@
-/* Mon Nov  2 22:44:58 2009 */
-/* Mixed revision working copy (13455M:13465) */
+/* Tue Nov 10 08:49:53 2009 */
 /* Code modified since last checkin */
-#define DBIXS_REVISION 13455
+#define DBIXS_REVISION 13479


and DBD::Oracle (sorry about the tabbling, it seems oci.8.c has some
very perculiar tabbling):

Index: oci8.c
===================================================================
--- oci8.c      (revision 13427)
+++ oci8.c      (working copy)
@@ -3279,10 +3279,33 @@
                                                while(datalen && p[datalen - 
1]==' ')
                                                        --datalen;
                                        }
-                                       sv_setpvn(sv, p, (STRLEN)datalen);
-                                       if (CSFORM_IMPLIES_UTF8(fbh->csform) ){
-                                               SvUTF8_on(sv);
-                                       }
+                    sv_setpvn(sv, p, (STRLEN)datalen);
+                    if (fbh->req_type != 0) {
+                        int sts;
+                        D_imp_xxh(sth);
+                        char errstr[256];
+
+
+                        sts = DBIc_DBISTATE(imp_sth)->sql_type_cast_svpv(
+                            aTHX_ sth, imp_xxh, sv, fbh->req_type,
fbh->bind_flags, NULL);
+                        if (sts == 0) {
+                            sprintf(errstr,
+                                    "over/under flow converting column
%d to type %ld",
+                                    i+1, fbh->req_type);
+                            oci_error(sth, imp_sth->errhp, OCI_ERROR,
errstr);
+                            return Nullav;
+
+                        } else if (sts == -2) {
+                            sprintf(errstr,
+                                    "unsupported bind type %ld for
column %d",
+                                    fbh->req_type, i+1);
+                            return Nullav;
+                        }
+                    } else {
+                        if (CSFORM_IMPLIES_UTF8(fbh->csform) ){
+                            SvUTF8_on(sv);
+                        }
+                    }
                                }
                        }

Index: dbdimp.c
===================================================================
--- dbdimp.c    (revision 13427)
+++ dbdimp.c    (working copy)
@@ -869,7 +869,50 @@
        return 1;
 }

+int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV
type, SV *attribs) {
+    dTHX;
+    int field;

+    if (!SvIOK(col)) {
+        croak ("Invalid column number") ;
+    }
+
+    field = SvIV(col);
+
+    if ((field < 1) || (field > DBIc_NUM_FIELDS(imp_sth))) {
+        croak("cannot bind to non-existent field %d", field);
+    }
+
+    imp_sth->fbh[field-1].req_type = type;
+    imp_sth->fbh[field-1].bind_flags = 2; /*DBIstcf_STRICT*/
+
+    if (attribs) {
+        HV *attr_hash;
+        SV **attr;
+
+        if (!SvROK(attribs)) {
+            croak ("attributes is not a reference");
+        } else if (SvTYPE(SvRV(attribs)) != SVt_PVHV) {
+            croak ("attributes not a hash reference");
+        }
+        attr_hash = (HV *)SvRV(attribs);
+
+        attr = hv_fetch(attr_hash, "LooselyTyped", (U32)12, 0);
+        if (attr && SvTRUE(*attr)) {
+            imp_sth->fbh[field-1].bind_flags &= ~(U32)2;
+        } else {
+            imp_sth->fbh[field-1].bind_flags |= 2;
+        }
+
+        attr = hv_fetch(attr_hash, "MinMemory", (U32)9, 0);
+        if (attr && SvTRUE(*attr)) {
+            imp_sth->fbh[field-1].bind_flags |= 1;
+        }
+    }
+
+    return 1;
+}
+
 int
 dbd_db_disconnect(SV *dbh, imp_dbh_t *imp_dbh)
 {
Index: dbdimp.h
===================================================================
--- dbdimp.h    (revision 13427)
+++ dbdimp.h    (working copy)
@@ -191,6 +191,9 @@
        int                     piece_lob;  /*use piecewise fetch for lobs*/
        /* Our storage space for the field data as it's fetched */
        sword           ftype;  /* external datatype we wish to get     */
+        IV            req_type;                /* type passed to
bind_col */
+        UV            bind_flags;               /* flags passed to
bind_col */
+
        fb_ary_t        *fb_ary ;       /* field buffer array                   
*/
        /* if this is an embedded object we use this */
        fbh_obj_t       *obj;
@@ -371,6 +374,7 @@
 #define dbd_st_FETCH_attrib    ora_st_FETCH_attrib
 #define dbd_describe           ora_describe
 #define dbd_bind_ph                    ora_bind_ph
+#define dbd_st_bind_col         ora_st_bind_col
 #include "ocitrace.h"

 /* end */
Index: Oracle.h
===================================================================
--- Oracle.h    (revision 13427)
+++ Oracle.h    (working copy)
@@ -67,6 +67,7 @@
 int     dbd_db_do _((SV *sv, char *statement));
 int     dbd_db_commit     _((SV *dbh, imp_dbh_t *imp_dbh));
 int     dbd_db_rollback   _((SV *dbh, imp_dbh_t *imp_dbh));
+int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV
type, SV *attribs);
 int     dbd_db_disconnect _((SV *dbh, imp_dbh_t *imp_dbh));
 void dbd_db_destroy    _((SV *dbh, imp_dbh_t *imp_dbh));
 int     dbd_db_STORE_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV
*valuesv));

Martin
-- 
Martin J. Evans
Easysoft Limited
http://www.easysoft.com

Reply via email to