Index: ocitrace.h =================================================================== --- ocitrace.h (revision 3715) +++ ocitrace.h (working copy) @@ -201,6 +201,19 @@ oci_status_name(stat)),stat : stat #if !defined(ORA_OCI_8) +#define OCILobCreateTemporary_log_stat(sv,eh,lh,csi,csf,lt,ca,dur,stat) \ + stat=OCILobCreateTemporary(sv,eh,lh,csi,csf,lt,ca,dur); \ + (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + "%sLobCreateTemporary(%p,%p,%p,%lu,%lu,%lu,%lu,%lu)=%s\n", \ + OciTp, (void*)sv,(void*)eh,(void*)lh, \ + ul_t(csi),ul_t(csf),ul_t(lt),ul_t(ca),ul_t(dur), \ + oci_status_name(stat)),stat : stat +#else +#define OCILobCreateTemporary_log_stat(sv,eh,lh,stat) \ + stat=0 /* Actually, this should be a compile error */ +#endif + +#if !defined(ORA_OCI_8) #define OCILobFreeTemporary_log_stat(sv,eh,lh,stat) \ stat=OCILobFreeTemporary(sv,eh,lh); \ (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ @@ -224,6 +237,13 @@ stat=0 #endif +#define OCILobLocatorAssign_log_stat(sv,eh,src,dest,stat) \ + stat=OCILobLocatorAssign(sv,eh,src,dest); \ + (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ + "%sLobLocatorAssign(%p,%p,%p,%p)=%s\n", \ + OciTp,(void*)sv,(void*)eh,(void*)src,(void*)dest, \ + oci_status_name(stat)),stat : stat + #define OCILobRead_log_stat(sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf,stat) \ stat=OCILobRead(sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf); \ (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \ Index: oci8.c =================================================================== --- oci8.c (revision 3715) +++ oci8.c (working copy) @@ -676,18 +676,31 @@ /* ------ */ +static int +fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name); + static int lob_phs_post_execute(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec) { if (pre_exec) return 1; + + /* fetch PL/SQL LOB data */ + if (imp_sth->auto_lob && ( + imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT_DECLARE )) { + + return fetch_lob(sth, imp_sth, (OCILobLocator*) phs->desc_h, phs->ftype, phs->sv, phs->name); + } + sv_setref_pv(phs->sv, "OCILobLocatorPtr", (void*)phs->desc_h); + return 1; } int dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { + D_imp_dbh_from_sth ; sword status; ub4 lobEmpty = 0; @@ -717,6 +730,80 @@ if (phs->is_inout) phs->out_prepost_exec = lob_phs_post_execute; + /* accept input LOBs */ + + if (sv_derived_from(phs->sv, "OCILobLocatorPtr")) { + OCILobLocator *src; + OCILobLocator **dest; + src = INT2PTR(OCILobLocator *, SvIV(SvRV(phs->sv))); + dest = (OCILobLocator **) phs->progv; + + OCILobLocatorAssign_log_stat(imp_dbh->svchp, imp_sth->errhp, src, dest, status); + if (status != OCI_SUCCESS) { + oci_error(sth, imp_sth->errhp, status, "OCILobLocatorAssign"); + return 0; + } + } + +#if !defined(ORA_OCI_8) + /* create temporary LOB for PL/SQL placeholder */ + + else if (imp_sth->auto_lob && (imp_sth->stmt_type == OCI_STMT_BEGIN || + imp_sth->stmt_type == OCI_STMT_DECLARE)) { + ub4 amtp; + + SvUPGRADE(phs->sv, SVt_PV); /* just in case */ + amtp = SvCUR(phs->sv); /* XXX UTF8? */ + + /* Create a temp lob for non-empty string */ + + if (amtp > 0) { + ub1 lobtype = (phs->ftype == 112 ? OCI_TEMP_CLOB : OCI_TEMP_BLOB); + + OCILobCreateTemporary_log_stat(imp_dbh->svchp, imp_sth->errhp, + (OCILobLocator *) phs->desc_h, (ub2) OCI_DEFAULT, + (ub1) OCI_DEFAULT, lobtype, TRUE, OCI_DURATION_SESSION, status); + + if (status != OCI_SUCCESS) { + oci_error(sth, imp_sth->errhp, status, "OCILobCreateTemporary"); + return 0; + } + + if( ! phs->csid ) { + ub1 csform = SQLCS_IMPLICIT; + ub2 csid = 0; + OCILobCharSetForm_log_stat( imp_sth->envhp, imp_sth->errhp, (OCILobLocator*)phs->desc_h, &csform, status ); + if (status != OCI_SUCCESS) + return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm"); +#ifdef OCI_ATTR_CHARSET_ID + /* Effectively only used so AL32UTF8 works properly */ + OCILobCharSetId_log_stat( imp_sth->envhp, imp_sth->errhp, (OCILobLocator*)phs->desc_h, &csid, status ); + if (status != OCI_SUCCESS) + return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetId"); +#endif /* OCI_ATTR_CHARSET_ID */ + /* if data is utf8 but charset isn't then switch to utf8 csid */ + csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); + phs->csid = csid; + phs->csform = csform; + } + + if (DBIS->debug >= 3) + PerlIO_printf(DBILOGFP, " calling OCILobWrite phs->csid=%d phs->csform=%d amtp=%d\n", + phs->csid, phs->csform, amtp ); + + /* write lob data */ + + OCILobWrite_log_stat(imp_sth->svchp, imp_sth->errhp, + (OCILobLocator*)phs->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE, + 0,0, phs->csid, phs->csform, status); + + if (status != OCI_SUCCESS) { + return oci_error(sth, imp_sth->errhp, status, "OCILobWrite in dbd_rebind_ph_lob"); + } + } + } +#endif + return 1; } @@ -949,28 +1036,28 @@ } - static int -fetch_func_autolob(SV *sth, imp_fbh_t *fbh, SV *dest_sv) +fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name) { ub4 loblen = 0; ub4 buflen; ub4 amtp = 0; int loblen_is_chars; - imp_sth_t *imp_sth = fbh->imp_sth; - OCILobLocator *lobloc = (OCILobLocator*)fbh->desc_h; sword status; + if (!name) + name = "an unknown field"; + /* this function is not called for NULL lobs */ /* The length is expressed in terms of bytes for BLOBs and BFILEs, */ /* and in terms of characters for CLOBs */ OCILobGetLength_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc, &loblen, status); if (status != OCI_SUCCESS) { - oci_error(sth, imp_sth->errhp, status, "OCILobGetLength fetch_func_autolob"); + oci_error(sth, imp_sth->errhp, status, "OCILobGetLength fetch_lob"); return 0; } - loblen_is_chars = (fbh->ftype == 112); + loblen_is_chars = (ftype == 112); if (loblen > imp_sth->long_readlen) { /* LOB will be truncated */ int oraperl = DBIc_COMPAT(imp_sth); @@ -987,8 +1074,8 @@ } else { char buf[300]; - sprintf(buf,"fetching field %d of %d. LOB value truncated from %ld to %ld. %s", - fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), ul_t(loblen), ul_t(amtp), + sprintf(buf,"fetching %s. LOB value truncated from %ld to %ld. %s", + name, ul_t(loblen), ul_t(amtp), "DBI attribute LongReadLen too small and/or LongTruncOk not set"); oci_error_err(sth, NULL, OCI_ERROR, buf, 24345); /* appropriate ORA error number */ sv_set_undef(dest_sv); @@ -1028,7 +1115,7 @@ return 0; } - if (fbh->dbtype == 114) { + if (ftype == 114) { OCILobFileOpen_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc, (ub1)OCI_FILE_READONLY, status); if (status != OCI_SUCCESS) { @@ -1043,11 +1130,11 @@ 0, 0, (ub2)0, csform, status); if (DBIS->debug >= 3) PerlIO_printf(DBILOGFP, - " OCILobRead field %d %s: csform %d, LOBlen %luc, LongReadLen %luc, BufLen %lub, Got %luc\n", - fbh->field_num+1, oci_status_name(status), csform, ul_t(loblen), + " OCILobRead %s %s: csform %d, LOBlen %luc, LongReadLen %luc, BufLen %lub, Got %luc\n", + name, oci_status_name(status), csform, ul_t(loblen), ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp)); - if (fbh->dbtype == 114) { + if (ftype == 114) { OCILobFileClose_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc, status); } @@ -1060,7 +1147,7 @@ /* tell perl what we've put in its dest_sv */ SvCUR(dest_sv) = amtp; *SvEND(dest_sv) = '\0'; - if (fbh->ftype == 112 && CSFORM_IMPLIES_UTF8(csform)) /* Don't set UTF8 on BLOBs */ + if (ftype == 112 && CSFORM_IMPLIES_UTF8(csform)) /* Don't set UTF8 on BLOBs */ SvUTF8_on(dest_sv); ora_free_templob(sth, imp_sth, lobloc); } @@ -1071,8 +1158,8 @@ *SvEND(dest_sv) = '\0'; if (DBIS->debug >= 3) PerlIO_printf(DBILOGFP, - " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, BufLen %lu, Got %lu\n", - fbh->field_num+1, "SKIPPED", ul_t(loblen), + " OCILobRead %s %s: LOBlen %lu, LongReadLen %lu, BufLen %lu, Got %lu\n", + name, "SKIPPED", ul_t(loblen), ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp)); } @@ -1081,7 +1168,16 @@ return 1; } +static int +fetch_func_autolob(SV *sth, imp_fbh_t *fbh, SV *dest_sv) +{ + char name[64]; + sprintf(name, "field %d of %d", fbh->field_num, DBIc_NUM_FIELDS(fbh->imp_sth)); + return fetch_lob(sth, fbh->imp_sth, (OCILobLocator*)fbh->desc_h, fbh->ftype, dest_sv, name); +} + + static int fetch_func_getrefpv(SV *sth, imp_fbh_t *fbh, SV *dest_sv) { @@ -1224,6 +1320,9 @@ long_readlen = (SvOK(imp_drh -> ora_long) && SvUV(imp_drh->ora_long)>0) ? SvUV(imp_drh->ora_long) : DBIc_LongReadLen(imp_sth); + /* set long_readlen for SELECT or PL/SQL with output placeholders */ + imp_sth->long_readlen = long_readlen; + if (imp_sth->stmt_type != OCI_STMT_SELECT) { /* XXX DISABLED, see num_fields test below */ if (DBIS->debug >= 3) PerlIO_printf(DBILOGFP, " dbd_describe skipped for %s\n", @@ -1444,7 +1543,6 @@ (int)num_fields, has_longs ); - imp_sth->long_readlen = long_readlen; /* Initialise cache counters */ imp_sth->in_cache = 0; imp_sth->eod_errno = 0; @@ -2087,6 +2185,10 @@ if (!imp_sth->auto_lob) return 1; /* application doesn't want magical lob handling */ + + if (imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT_DECLARE) + return 1; /* PL/SQL is handled by lob_phs_post_execute */ + if (row_count == 0) return 1; /* nothing to do */ if (row_count > 1) Index: dbdimp.c =================================================================== --- dbdimp.c (revision 3715) +++ dbdimp.c (working copy) @@ -1417,6 +1417,7 @@ if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue) /* dbi handle allowed for cursor variables */ && !SvAMAGIC(newvalue) /* overload magic allowed (untested) */ + && !sv_derived_from(newvalue, "OCILobLocatorPtr" ) /* input LOB locator*/ ) croak("Can't bind a reference (%s)", neatsvpv(newvalue,0)); if (SvTYPE(newvalue) > SVt_PVLV) /* hook for later array logic? */ @@ -1856,6 +1857,7 @@ { if (phs->desc_h) OCIDescriptorFree_log(phs->desc_h, phs->desc_t); + sv_free(phs->ora_field); sv_free(phs->sv); } @@ -1942,6 +1944,10 @@ while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) { if (sv != &sv_undef) { phs_t *phs = (phs_t*)(void*)SvPVX(sv); + + if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB) + ora_free_templob(sth, imp_sth, (OCILobLocator*)phs->desc_h); + ora_free_phs_contents(phs); } } Index: t/31lob.t =================================================================== --- t/31lob.t (revision 3715) +++ t/31lob.t (working copy) @@ -1,7 +1,7 @@ #!/usr/bin/perl use strict; -use Test::More tests => 2; +use Test::More tests => 9; use DBD::Oracle qw(:ora_types); use DBI; @@ -47,6 +47,128 @@ $sth->execute; is (ref $loc, "OCILobLocatorPtr", "returned valid locator"); +sub temp_lob_count { + my $dbh = shift; + my $stmt = " + SELECT cache_lobs + nocache_lobs AS temp_lob_count + FROM v\$temporary_lobs templob, + v\$session sess + WHERE sess.sid = templob.sid + AND sess.audsid = userenv('sessionid') "; + my ($count) = $dbh->selectrow_array($stmt); + return $count; +} + +## test writing / reading large data +{ + # LOB locators cannot span transactions - turn off AutoCommit + local $dbh->{AutoCommit} = 0; + my ( $large_value, $len ); + + # get a new locator + $stmt = "INSERT INTO $table (id,data) VALUES (3, EMPTY_BLOB())"; + $dbh->do($stmt); + $stmt = "SELECT data FROM $table WHERE id = ?"; + $sth = $dbh->prepare( $stmt, { ora_auto_lob => 0 } ); + $id = 3; + $sth->bind_param( 1, $id ); + $sth->execute; + ($loc) = $sth->fetchrow; + + is( ref $loc, "OCILobLocatorPtr", "returned valid locator" ); + + # write string > 32k + $large_value = 'ABCD' x 10_000; + + $dbh->ora_lob_write( $loc, 1, $large_value ); + is( $dbh->ora_lob_length($loc), length($large_value), "returned length" ); + is( $dbh->ora_lob_read( $loc, 1, length($large_value) ), + $large_value, "returned written value" ); + + ## PL/SQL TESTS + SKIP: { + ## test calling PL/SQL with LOB placeholder + my $plsql_testcount = 4; + + $stmt = "BEGIN ? := DBMS_LOB.GETLENGTH( ? ); END;"; + $sth = $dbh->prepare( $stmt, { ora_auto_lob => 0 } ); + $sth->bind_param_inout( 1, \$len, 16 ); + $sth->bind_param( 2, $loc, { ora_type => ORA_BLOB } ); + $sth->execute; + + # ORA-00600: internal error code + # ORA-00900: invalid SQL statement + # ORA-06550: PLS-00201: identifier 'DBMS_LOB.GETLENGTH' must be declared + # ORA-06553: PLS-00213: package STANDARD not accessible + + if ( $dbh->err && grep { $dbh->err == $_ } ( 600, 900, 6550, 6553 ) ) { + skip "Your Oracle server doesn't support PL/SQL", $plsql_testcount + if $dbh->err == 900; + skip + "Your Oracle PL/SQL package DBMS_LOB is not properly installed", $plsql_testcount + if $dbh->err == 6550; + skip "Your Oracle PL/SQL is not properly installed", $plsql_testcount + if $dbh->err == 6553 || $dbh->err == 600; + } + + is( $len, length($large_value), "returned length via PL/SQL" ); + + + + $stmt = " + DECLARE + -- testing IN, OUT, and IN OUT: + -- p_out will be set to LOWER(p_in) + -- p_inout will be set to p_inout || p_in + + PROCEDURE lower_lob(p_in BLOB, p_out OUT BLOB, p_inout IN OUT BLOB) IS + pos INT; + buffer RAW(1024); + BEGIN + DBMS_LOB.CREATETEMPORARY(p_out, TRUE); + pos := 1; + WHILE pos <= DBMS_LOB.GETLENGTH(p_in) + LOOP + buffer := DBMS_LOB.SUBSTR(p_in, 1024, pos); + + DBMS_LOB.WRITEAPPEND(p_out, UTL_RAW.LENGTH(buffer), + UTL_RAW.CAST_TO_RAW(LOWER(UTL_RAW.CAST_TO_VARCHAR2(buffer)))); + + DBMS_LOB.WRITEAPPEND(p_inout, UTL_RAW.LENGTH(buffer), buffer); + + pos := pos + 1024; + END LOOP; + END; + BEGIN + lower_lob(:in, :out, :inout); + END; "; + + my $out; + my $inout = lc $large_value; + + local $dbh->{LongReadLen} = length($large_value) * 2; + + $sth = $dbh->prepare( $stmt, { ora_auto_lob => 1 } ); + $sth->bind_param( ':in', $large_value, { ora_type => ORA_BLOB }); + $sth->bind_param_inout( ':out', \$out, 100, { ora_type => ORA_BLOB } ); + $sth->bind_param_inout( ':inout', \$inout, 100, { ora_type => ORA_BLOB } ); + $sth->execute; + + skip "Your Oracle PL/SQL installation does not implement temporary LOBS", 3 + if $dbh->err && $dbh->err == 6550; + + is($out, lc($large_value), "returned LOB as string"); + is($inout, lc($large_value).$large_value, "returned IN/OUT LOB as string"); + + undef $sth; + # lobs are freed with statement handle + + is(temp_lob_count($dbh), 0, "no temp lobs left"); + } +} + + + $dbh->do("DROP TABLE $table"); $dbh->disconnect;