in reply to Re: Perl XS - is this code required in DBD::Pg? (cruft)
in thread Perl XS - is this code required in DBD::Pg?

Interesting comments tye. The code as I have it in DBD::ODBC does indeed pass is \$buf from Perl and works fine. The only bit from the DBD::Pg code I omitted was the sv_setpvn. Logically, I think the method I'm creating should pass in a reference to a scalar and that scalar should be grown to fit the returned lob data so I'll play with your suggested changes. Thanks. As it stands I have:

void odbc_lob_read(sth, colno, buf, length, attr = NULL) SV *sth int colno char *buf UV length SV *attr; PROTOTYPE: $$$$;$ PREINIT: SV * const bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2); UV ret_len; IV sql_type = 0; CODE: if (length == 0) { croak("Cannot retrieve 0 length lob"); } if (attr) { SV **svp; DBD_ATTRIBS_CHECK("odbc_lob_read", sth, attr); DBD_ATTRIB_GET_IV(attr, "Type", 4, svp, sql_type); } sv_setpvn(bufsv, "", 0); /* ensure we can grow +ok */ /* length is the length in chrs/bytes depending on the underlying * datatype. i.e., it is usually bytes but if we are built to sup +port * unicode and the column is not a binary type, we will convert t +o * UTF8 encoding so we need at least 6 * as many bytes. */ buf = SvGROW(bufsv, length * + 1); ret_len = odbc_st_lob_read(sth, colno, bufsv, length, sql_type); if (ret_len > 0) { SvCUR_set(bufsv, ret_len); /* set length in SV */ *SvEND(bufsv) = '\0'; /* NUL terminate */ /*sv_setpvn(ST(3), buf, 4);*/ SvSETMAGIC(ST(2)); } ST(0) = (ret_len >= 0) ? sv_2mortal(newSViv(ret_len)) : &PL_sv_un +def;

and Perl code

my $s = $h->prepare(q{select 'frederick'}); $s->execute; $s->bind_col(1, undef, {BindAsLOB=>1}); $s->fetch; # SQL_SUCCESS = 0 # SQL_SUCCESS_WITH_INFO = 1 # SQL_NO_DATA = 100 while(my $len = $s->odbc_lob_read(1, \my $x, 8)) { print "len=$len, x=$x\n"; }

Replies are listed 'Best First'.
Re^3: Perl XS - is this code required in DBD::Pg? (empty)
by tye (Sage) on Jul 21, 2010 at 19:14 UTC

    Heh, rereading the same basic code in your implementation made me realize that there is another minor bug. SvSETMAGIC() doesn't get called if the 'read' is successful but returns no data. That suggests the following simplification:

    void odbc_lob_read(sth, colno, bufsv, length, attr = NULL) SV *sth int colno SV *bufsv UV length SV *attr; PROTOTYPE: $$$$;$ PREINIT: char *buf; UV ret_len; IV sql_type = 0; CODE: if (length == 0) { croak("Cannot retrieve 0 length lob"); } if (SvROK(bufsv)) { bufsv = SvRV(bufsv); } if (attr) { SV **svp; DBD_ATTRIBS_CHECK("odbc_lob_read", sth, attr); DBD_ATTRIB_GET_IV(attr, "Type", 4, svp, sql_type); } sv_setpvn(bufsv, "", 0); /* ensure we can grow +ok */ buf = SvGROW(bufsv, length + 1); ret_len = odbc_st_lob_read(sth, colno, bufsv, length, sql_type); if (ret_len < 0) { ST(0) = &PL_sv_undef; } else { SvCUR_set(bufsv, ret_len); /* set length in SV */ *SvEND(bufsv) = '\0'; /* NUL terminate */ SvSETMAGIC(bufsv); ST(0) = sv_2mortal(newSViv(ret_len)); } XSRETURN(1);

    (Update: Added XSRETURN(1) after prompting in the chatterbox from ikegami.)

    - tye        

      Most grateful for you input tye++ - this is why I love perlmonks. I obviously need to work on this more before releasing it.

      Thanks again tye. I ended up with the following:

      SV * odbc_lob_read(sth, colno, bufsv, length, attr = NULL) SV *sth int colno SV *bufsv UV length SV *attr; PROTOTYPE: $$$$;$ PREINIT: char *buf; UV ret_len; IV sql_type = 0; INIT: if (length == 0) { croak("Cannot retrieve 0 length lob"); } CODE: if (attr) { SV **svp; DBD_ATTRIBS_CHECK("odbc_lob_read", sth, attr); DBD_ATTRIB_GET_IV(attr, "Type", 4, svp, sql_type); } if (SvROK(bufsv)) { bufsv = SvRV(bufsv); } sv_setpvn(bufsv, "", 0); /* ensure we can grow +ok */ buf = SvGROW(bufsv, length + 1); ret_len = odbc_st_lob_read(sth, colno, bufsv, length, sql_type); if (ret_len > 0) { SvCUR_set(bufsv, ret_len); /* set length in SV */ *SvEND(bufsv) = '\0'; /* NUL terminate */ SvSETMAGIC(bufsv); RETVAL = newSViv(ret_len); } else { XSRETURN_UNDEF; } OUTPUT: RETVAL

      Thanks again for your suggestions.

        I encourage you to replace if (ret_len > 0) { with if (ret_len >= 0) {.

        Your code as written causes undef to be returned on EOF (I believe). Although there is prior art for this in Perl, it also means that your callers can't distinguish between EOF and an error. A lot of the time this doesn't matter (obviously, or else Perl would have changed this a long time ago).

        But sometimes it is important to distinguish between EOF and an error. This is especially true when reading from a socket (which I assume is the typical case for something like DBD::pg). (This is another reason why one shouldn't use <$SOCK> with sockets.)

        If you use <= 0, then the easy case is no more difficult (you just read until you get a false value: 0 or undef). But a caller can go to a little extra effort to detect undef and report a failure -- including $! at the time of the failure which will likely explain why the read attempt failed, to some level. With the code as-is, you have quite effectively hidden whether an error has occurred and made it impossible to reliably report such errors.

        Having tried to write tests around "errors while reading" in Perl, I know well how hard it is to try to guess that an error actually happened and how easy those difficult guesses end being wrong.

        I would hope that something like DBD::pg would report read failures such that $! can explain what went wrong rather than having to guess what went wrong when an invalid (actually, incomplete) packet/response can't be parsed (or even risking that an incomplete response could still be parsed).

        - tye