mje has asked for the wisdom of the Perl Monks concerning the following question:

I was adding a new method to DBD::ODBC and started by looking at a similar method in DBD::Pg which in XS is:

pg_lo_read(dbh, fd, buf, len) SV * dbh int fd char * buf size_t len PREINIT: SV * const bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2); int ret; CODE: sv_setpvn(bufsv,"",0); /* Make sure we can grow it saf +ely */ buf = SvGROW(bufsv, len + 1); ret = pg_db_lo_read(dbh, fd, buf, len); if (ret > 0) { SvCUR_set(bufsv, ret); *SvEND(bufsv) = '\0'; sv_setpvn(ST(2), buf, (unsigned)ret); SvSETMAGIC(ST(2)); } ST(0) = (ret >= 0) ? sv_2mortal(newSViv(ret)) : &PL_sv +_undef;

pg_db_lo_read is passed the char * buf of bufsv and fills it with the lob data so why is the line "sv_setpvn(ST(2), buf, (unsigned)ret);" required? When I copied this code and used it in DBD::ODBC but omitted that line it worked fine. It seems to me that the line in question is not required. Any comments?

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

    You should try passing in a \$buf instead of $buf (using both implementations).

    The "char * buf" formal argument is misleading and is only ever used as an ordinary lexcial "char *" variable.

    The PREINIT: line, SV * const bufsv = SvROK(ST(2­)) ? SvRV(ST(2)­) : ST(2); means that you can either pass in $buf to have it populated or pass in \$buf. It looks to me like the line you asked about is just wasteful in the case of passing in $buf. I think it actually breaks things if you pass in \$buf.

    It smells like historical baggage. I'd rewrite the code like so:

    pg_lo_read( dbh, fd, bufsv, len ) SV * dbh int fd SV * bufsv size_t len CODE: int ret; char * buf; if( SvROK(bufsv) ) { bufsv= SvRV(bufsv); } sv_setpvn(bufsv,"",0); /* Make sure we can grow it safely */ buf= SvGROW( bufsv, len + 1 ); ret= pg_db_lo_read( dbh, fd, buf, len ); if( 0 < ret ) { SvCUR_set( bufsv, ret ); *SvEND(bufsv)= '\0'; SvSETMAGIC( bufsv ); } ST(0)= 0 <= ret ? sv_2mortal(newSViv(ret)) : &PL_sv_undef;

    - tye        

      SvSETMAGIC( ST(2) );    /* Is this correct? */
      should be
      SvSETMAGIC( bufsv );

      The idea is to call tied($buf)->STORE() or similar if applicable.

        Thanks. I had meant to replace ST(2) with bufsv (as I did other places). In the mean time I had read the docs on SvSETMAGIC() which indicated that usage was correct.

        I'll update my original code block since you quote my original line above.

        - tye        

        Thanks ikegami. I am no XS or Perl internals expert so I appreciate the advice. I'll amend the code and come back here if that is all right.

      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"; }

        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        

Re: Perl XS - is this code required in DBD::Pg?
by ikegami (Patriarch) on Jul 21, 2010 at 18:31 UTC

    It does something when SvROK(ST(2)) is true on entry, but it looks like a bug. (It's replacing a reference to the buf with the buf itself as a I read it.)

    Update: More precisely, it's changing the contents of the scalar passed to the function from a reference to a string containing a copy of the buf. It does so for the sole purpose of calling SvSETMAGIC on the wrong variable.