Author: byterock
Date: Tue May 20 07:11:08 2008
New Revision: 11295
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/Oracle.pm
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/ocitrace.h
dbd-oracle/trunk/t/32xmltype.t
dbd-oracle/trunk/t/34pres_lobs.t
Log:
this should be working correctly now. Added comments and cleaned up pod and
added debugging code and oci trace code
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Tue May 20 07:11:08 2008
@@ -1,5 +1,6 @@
=head1 Changes in DBD-Oracle 1.22(svn rev xxxx) 2008
- Makefile.PL now working without flags for Linux 11.1.0.6 instant client and
regular client from John Scoles, Andy Sautins, H.Merijn Brand and Nathan
Vonnahme
+ Makefile.PL now working without flags for Linux 11.1.0.6 instant client and
regular client from John Scoles, Andy Sautins, H.Merijn Brand, Nathan Vonnahme
and Karun Dutt
+ Fixed how persistant lob fetch works now uses callback correctly, from John
Scoles
=head1 Changes in DBD-Oracle 1.21(svn rev 11067) 11th April 2008
Added Notes to README.win32.txt on installing Instant Client 11.1.0.6.0 from
John Scoles
Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Tue May 20 07:11:08 2008
@@ -1470,9 +1470,13 @@
=item ora_pers_lob
-If 1 and your DBD::Oracle was built using OCI 10.2 or later the L<Data
Interface for Persistent LOBs> will be
+If 1 and your DBD::Oracle was built using OCI 10.2 and you are selecting
against an Oralce 10R2 DB or later the L<Data Interface for Persistent LOBs>
will be
used for LOBs.
+=item ora_piece_size
+
+This is the max piece size, in char for CLOBS, and bytes for BLOBS, for use
with the <Data Interface for Persistent LOBs>.
+
=item ora_check_sql
If 1 (default), force SELECT statements to be described in prepare().
@@ -2733,10 +2737,11 @@
=head1 Data Interface for Persistent LOBs
-Oracle 10.2 and later extended the OCI API to work directly with LOB
datatypes. In other words you can treat all LOB type data as if it was
+Oracle 10R2 and later extended the OCI API to work directly with LOB
datatypes. In other words you can treat all LOB type data as if it was
a LONG, LONG RAW, or VARCHAR2. So you can perform INSERT, UPDATE, fetch, bind,
and define operations on LOBs using the same techniques
you would use on other datatypes that store character or binary data. There
are fewer round trips to the server as no 'LOB Locators' are
-used, normally one can get an entire LOB is a single round trip. The data
interface is suppose to supports LOBs of any size less than 2GB.
+used, normally one can get an entire LOB is a single round trip. The data
interface is supports LOBs of any size less than 2GB. Only
+support for 'Selects' has been implemented using a piecewise callback fetch.
=head2 Simple Usage
@@ -2744,9 +2749,9 @@
use DBD::Oracle qw(:ora_types);
-and ensure the set statement handle's prepare method 'ora_pers_lob' attribute
is set to '1' and the database
-handle's 'LongReadLen' attribute is set to a value that will exceed the
expected size of the LOB. If the size of the lob exceeds this then DBD::Oracle
-will return a 'ORA-24345: A Truncation' error. To stop this set the handle's
'LongTruncOk' attribute to '1'.
+Next ensure the set statement handle's prepare method 'ora_pers_lob' attribute
is set to '1', and set the 'ora_piece_size' to the size of the pieces
+you want to return on the callback. Finally set the database handle's
'LongReadLen' attribute to a value that will be the larger than the expected
+size of the LOB. If the size of the lob exceeds this then DBD::Oracle will
return a 'ORA-24345: A Truncation' error. To stop this set the handle's
'LongTruncOk' attribute to '1'.
For example give this table;
@@ -2760,7 +2765,7 @@
$dbh->{LongReadLen} = 2*1024*1024; #2 meg
$SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs';
- $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1,ora_piece_size=>1*1024*1024});
$sth->execute();
while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
print "p_id=".$p_id."\n";
@@ -2770,11 +2775,14 @@
print "blob2=".$blob2."\n";
}
-Will select out all of the LOBs in the table as long as they are all under 2MB
in length. Longer lobs will throw a error. Adding this line;
+Will select out all of the LOBs in the table as long as they are all under 2MB
in length. If the LOB is longer than 1meg(ora_piece_size) it will fetch it in
at least two pieces,
+Longer lobs will throw a error. Adding this line;
$dbh->{LongTruncOk}=1;
-before the execute will return all the lobs but they will only be a maximum of
2MB in size.
+before the execute will return all the lobs but they will only be a maximum of
2MB in size.
+If 'ora_piece_size' is omitted then the value for piece size will default to
your 'LongReadLen'. The maximum value for 'ora_piece_size' is
+about 15meg and 'LongReadLen' is about 4gig.
=head2 Binding for Updates and Inserts
@@ -2807,9 +2815,8 @@
$dbh = DBI->connect('dbi:Oracle:','[EMAIL PROTECTED]','test');
$dbh->{LongReadLen} = 2*1024*1024; #2 meg
- $sth=$dbh->prepare($SQL,{ora_pers_lob=>1});
$SQL='select p_id,lob_1,lob_2,blob_2 from [EMAIL PROTECTED]';
- $sth=$dbh->prepare($SQL,{ora_pers_lob=>1,ora_check_sql=>0});
+ $sth=$dbh->prepare($SQL,{ora_pers_lob=>1,ora_piece_size=>1*1024*1024});
$sth->execute();
while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){
print "p_id=".$p_id."\n";
@@ -2889,8 +2896,7 @@
1) Piecewise, and callback binds for INSERT and UPDATE operations.
2) Array binds for INSERT and UPDATE operations.
- 3) Piecewise and callback binds for SELECT operation.
-
+
=head1 Handling LOBs
Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Tue May 20 07:11:08 2008
@@ -122,11 +122,11 @@
typedef struct fb_ary_st fb_ary_t; /* field buffer array */
struct fb_ary_st { /* field buffer array EXPERIMENTAL */
ub4 bufl; /* length of data buffer */
- ub4 cb_bufl; /* length of piece of data fetched in callback */
- ub4 piece_count;
+ ub4 cb_bufl; /* length of piece of data fetched in callback.*/
+ ub4 piece_count;/*# of pieces retrieved*/
sb2 *aindp; /* null/trunc indicator variable */
ub1 *abuf; /* data buffer (points to sv data) */
- ub1 *cb_abuf; /*yet another buffer for picewise callbacks*/
+ ub1 *cb_abuf; /*yet another buffer for picewise callbacks this means
I only need to allocate memory once a prepare rather than at each fetch*/
ub2 *arlen; /* length of returned data */
ub2 *arcode; /* field level error status */
};
Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Tue May 20 07:11:08 2008
@@ -589,17 +589,16 @@
/* --------------------------------------------------------------
Fetch callback fill buffers.
- Finalyy figured out how this fucntion works
+ Finaly figured out how this fucntion works
Seems it is like this. The function inits and then fills the
- buffer (fb_ary->abuf) with the data from the select untill it
+ buffer (fb_ary->abuf) with the data from the select until it
either runs out of data or its max size is reached
(fb_ary->bufl). If its max size is reached it then goes and gets
the the next piece and sets *piecep ==OCI_NEXT_PIECE at this point
I take the data in the buffer and strncat it onto my piece buffer
- fb_ary->cb_abuf. This will go on until it runs out of pieces
- There is no way in this function to get this (at least I do not know
- how) so when it returns to back to the fetch I add what remains in
- (fb_ary->bufl) (the last piece) and strncat onto fb_ary->cb_abuf
+ (fb_ary->cb_abuf). This will go on until it runs out of full pieces
+ so when it returns to back to the fetch I add what remains in
+ (fb_ary->bufl) (the last piece) and strncat onto my piece buffer
(fb_ary->cb_abuf)
to get it all. I also take set fb_ary->cb_abuf back to empty just
to keep things clean
-------------------------------------------------------------- */
@@ -616,9 +615,9 @@
*indpp = (dvoid *) fb_ary->aindp;
*rcpp = fb_ary->arcode;
- if ( *piecep ==OCI_NEXT_PIECE ){
+ if ( *piecep ==OCI_NEXT_PIECE ){/*more than one piece*/
- fb_ary->cb_abuf= strncat( fb_ary->cb_abuf, fb_ary->abuf,fb_ary->bufl);
+ fb_ary->cb_abuf= strncat( fb_ary->cb_abuf,
fb_ary->abuf,(STRLEN)fb_ary->bufl);/*cat into the the cb buffer the piece*/
fb_ary->piece_count++;/*used to tell me how many pieces I have, Might
be able to use aindp for this?*/
}
@@ -1744,7 +1743,8 @@
}
-/*static int
+/*static int This is another way to do the callback using set and get piece
not
+used right now.
fetch_presis_binary(SV *sth, imp_fbh_t *fbh,SV *dest_sv){
dTHX;
@@ -1835,7 +1835,23 @@
}
-
+static void
+fetch_cleanup_pres_lobs(SV *sth,imp_fbh_t *fbh){
+ dTHX;
+ fb_ary_t *fb_ary = fbh->fb_ary;
+
+ if( sth ) { /* For GCC not to warn on unused parameter*/ }
+ fb_ary->piece_count=0;/*reset the peice counter*/
+ memset( fb_ary->abuf, '\0', fb_ary->bufl); /*clean out the piece fetch
buffer*/
+ fb_ary->bufl=fbh->piece_size; /*reset this back to the piece length */
+ fb_ary->cb_bufl=fbh->disize; /*reset this back to the max size for the
fetch*/
+ memset( fb_ary->cb_abuf, '\0', fbh->disize ); /*clean out the call back
buffer*/
+
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOGFP," fetch_cleanup_pres_lobs \n");
+
+ return;
+}
static void
fetch_cleanup_oci_object(SV *sth, imp_fbh_t *fbh){
@@ -2372,11 +2388,12 @@
/* do we need some addition size logic here? (lab) */
if (imp_sth->pers_lob){ /*this only works on
10.2 */
- fbh->pers_lob = 1;
- fbh->define_mode = OCI_DYNAMIC_FETCH; /*
piecwise fetch*/
- fbh->disize = imp_sth->long_readlen;
/*user set max value*/
- fbh->piece_size = imp_sth->piece_size;
-
+ fbh->pers_lob = 1;
+ fbh->define_mode = OCI_DYNAMIC_FETCH; /*
piecwise fetch*/
+ fbh->disize = imp_sth->long_readlen;
/*user set max value for the fetch*/
+ fbh->piece_size = imp_sth->piece_size; /*the
size for each piece*/
+ fbh->fetch_cleanup =
fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
+
if (!imp_sth->piece_size){ /*if not set use max
value*/
imp_sth->piece_size=imp_sth->long_readlen;
}
@@ -2476,7 +2493,7 @@
fb_ary_t *fb_ary;
fbh->fb_ary = fb_ary_alloc(define_len, 1);
- if (fbh->pers_lob){
+ if (fbh->pers_lob){/*init the cb_abuf with this call*/
fbh->fb_ary =
fb_ary_cb_alloc(imp_sth->piece_size,define_len, imp_sth->rs_array_size);
} else {
@@ -2511,14 +2528,11 @@
if (fbh->pers_lob) {
- /* uses a dynamic callback for persistent
binary and char lobs*/
- OCIDefineDynamic(fbh->defnp, imp_sth->errhp,
(dvoid *) fbh,
- (OCICallbackDefine)
presist_lob_fetch_cbk);
+ /* use a dynamic callback for persistent
binary and char lobs*/
+
OCIDefineDynamic_log_stat(fbh->defnp,imp_sth->errhp,(dvoid *) fbh,status);
}
-
-
if (fbh->ftype == 108) { /* Embedded object bind it
differently*/
if (DBIS->debug >= 5){
@@ -2555,16 +2569,16 @@
#ifdef OCI_ATTR_CHARSET_FORM
if ( (fbh->dbtype == 1) && fbh->csform ) {
/* csform may be 0 when talking to Oracle 8.0 database*/
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " calling OCIAttrSet
OCI_ATTR_CHARSET_FORM with csform=%d\n", fbh->csform );
- OCIAttrSet_log_stat( fbh->defnp, (ub4) OCI_HTYPE_DEFINE,
(dvoid *) &fbh->csform,
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOGFP, " calling OCIAttrSet
OCI_ATTR_CHARSET_FORM with csform=%d\n", fbh->csform );
+ OCIAttrSet_log_stat( fbh->defnp, (ub4)
OCI_HTYPE_DEFINE, (dvoid *) &fbh->csform,
(ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM,
imp_sth->errhp, status );
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, "OCIAttrSet
OCI_ATTR_CHARSET_FORM");
- ++num_errors;
- }
- }
- #endif /* OCI_ATTR_CHARSET_FORM */
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIAttrSet
OCI_ATTR_CHARSET_FORM");
+ ++num_errors;
+ }
+ }
+#endif /* OCI_ATTR_CHARSET_FORM */
}
@@ -2719,16 +2733,22 @@
if (fbh->pers_lob){
ub4
actual_bufl=imp_sth->piece_size*(fb_ary->piece_count)+fb_ary->bufl;
if (fb_ary->piece_count==0){
+
+ if (DBIS->debug >= 6)
+
PerlIO_printf(DBILOGFP," Fetch persistent lob of %d (char/bytes) with callback
in 1 piece of %d (Char/Bytes)\n",actual_bufl,fb_ary->bufl);
strcpy (fb_ary->cb_abuf,fb_ary->abuf);
} else {
+ if (DBIS->debug >= 6)
+
PerlIO_printf(DBILOGFP," Fetch persistent lob of %d (Char/Bytes) with callback
in %d piece(s) of %d (Char/Bytes) and one piece of %d
(Char/Bytes)\n",actual_bufl,fb_ary->piece_count,fbh->piece_size,fb_ary->bufl);
+
fb_ary->cb_abuf= strncat( fb_ary->cb_abuf,
fb_ary->abuf,fb_ary->bufl);
}
-
+
if (fbh->ftype == SQLT_BIN){
*(fb_ary->cb_abuf+(actual_bufl))='\0';
/* add a null teminator*/
- sv_setpvn(sv, (char*)fb_ary->cb_abuf,
actual_bufl);
+ sv_setpvn(sv, (char*)fb_ary->cb_abuf,
actual_bufl);
} else {
@@ -2737,13 +2757,8 @@
SvUTF8_on(sv);
}
}
-
- fb_ary->piece_count=0;/*reset this back to the disize */
- memset( fb_ary->abuf, '\0', fb_ary->bufl);
- fb_ary->bufl=fbh->piece_size; /*reset this back to the
disize */
- fb_ary->cb_bufl=fbh->disize;
- memset( fb_ary->cb_abuf, '\0', fbh->disize );
-
+
+
} else {
int datalen =
fb_ary->arlen[imp_sth->rs_array_idx];
char *p = (char*)row_data;
@@ -2761,13 +2776,6 @@
} else if (rc == 1405) { /* field is null - return undef
*/
sv_set_undef(sv);
- if (fbh->pers_lob){
- fb_ary->piece_count=0;/*reset this back to the
disize */
- memset( fb_ary->abuf, '\0', fb_ary->bufl);
- fb_ary->bufl=imp_sth->piece_size; /*reset this
back to the disize */
- fb_ary->cb_bufl=fbh->disize;
- memset( fb_ary->cb_abuf, '\0', fbh->disize );
- }
} else { /* See odefin rcode arg description in OCI docs
*/
char buf[200];
char *hint = "";
Modified: dbd-oracle/trunk/ocitrace.h
==============================================================================
--- dbd-oracle/trunk/ocitrace.h (original)
+++ dbd-oracle/trunk/ocitrace.h Tue May 20 07:11:08 2008
@@ -37,6 +37,13 @@
*/
+#define OCIDefineDynamic_log_stat(defnp,errhp,fbh,stat)\
+ stat =OCIDefineDynamic(defnp,errhp,fbh,(OCICallbackDefine)
presist_lob_fetch_cbk );\
+ (DBD_OCI_TRACEON) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP,\
+ "%sOCIDefineDynamic_log_stat(%p,%p,%p)=%s\n",\
+ OciTp, (void*)defnp,
(void*)errhp,fbh,oci_status_name(stat)),stat \
+ : stat
#define
OCIXMLTypeCreateFromSrc_log_stat(svchp,envhp,src_type,src_ptr,xml,stat)\
stat =OCIXMLTypeCreateFromSrc
(svchp,envhp,(OCIDuration)OCI_DURATION_CALLOUT,(ub1)src_type,(dvoid
*)src_ptr,(sb4)OCI_IND_NOTNULL, xml);\
Modified: dbd-oracle/trunk/t/32xmltype.t
==============================================================================
--- dbd-oracle/trunk/t/32xmltype.t (original)
+++ dbd-oracle/trunk/t/32xmltype.t Tue May 20 07:11:08 2008
@@ -31,7 +31,11 @@
# check that our db handle is good
isa_ok($dbh, "DBI::db");
+
+
my $table = table();
+eval { $dbh->do("DROP TABLE $table") };
+
$dbh->do(qq{
CREATE TABLE $table (
id INTEGER NOT NULL,
Modified: dbd-oracle/trunk/t/34pres_lobs.t
==============================================================================
--- dbd-oracle/trunk/t/34pres_lobs.t (original)
+++ dbd-oracle/trunk/t/34pres_lobs.t Tue May 20 07:11:08 2008
@@ -40,6 +40,7 @@
my $table = table();
+eval { $dbh->do("DROP TABLE $table") };
ok($dbh->do(qq{
CREATE TABLE $table (
@@ -70,7 +71,7 @@
$sql='select * from '.$table;
-ok($sth=$dbh->prepare($sql,{ora_pers_lob=>1}));
+ok($sth=$dbh->prepare($sql,{ora_pers_lob=>1,ora_piece_size=>.5*1024*1024}));
ok($sth->execute());
