Author: byterock
Date: Wed Mar 19 08:27:23 2008
New Revision: 10946
Added:
dbd-oracle/trunk/t/51scroll.t
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/Oracle.h
dbd-oracle/trunk/Oracle.pm
dbd-oracle/trunk/Oracle.xs
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/ocitrace.h
Log:
Changed the way pre-fetching is done by John Scoles
Added support for Scrollable cursors from John Scoles
Changed the max size of cache_rows to a ub4 rather than a ub2 from John Scoles
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Wed Mar 19 08:27:23 2008
@@ -1,4 +1,7 @@
=head1 Changes in DBD-Oracle 1.21(svn rev xxxx)
+ Changed the way pre-fetching is done by John Scoles
+ Added support for Scollable cursors from John Scoles
+ Changed the max size of cache_rows to a ub4 rather than a ub2 from John
Scoles
Added support for Lobs in select of OCI Embedded Objects from John Scoles
with a big thankyou to Paul Weiss
Fixed for embedded object in object from Paul Weiss
Added support for direct insert of large XML data into XMLType fields from
Hendrik Fuss
Modified: dbd-oracle/trunk/Oracle.h
==============================================================================
--- dbd-oracle/trunk/Oracle.h (original)
+++ dbd-oracle/trunk/Oracle.h Wed Mar 19 08:27:23 2008
@@ -99,4 +99,5 @@
#define ORA_VARCHAR2_TABLE 201
#define ORA_NUMBER_TABLE 202
#define ORA_NTY 108
+
/* end of Oracle.h */
Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Wed Mar 19 08:27:23 2008
@@ -22,13 +22,18 @@
ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE
ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_NTY
ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE
- SQLT_INT SQLT_FLT XMLType
+ SQLT_INT SQLT_FLT ORA_OCI
) ],
ora_session_modes => [ qw( ORA_SYSDBA ORA_SYSOPER ) ],
+ ora_fetch_orient => [ qw( OCI_FETCH_NEXT OCI_FETCH_CURRENT
OCI_FETCH_FIRST
+ OCI_FETCH_LAST OCI_FETCH_PRIOR
OCI_FETCH_ABSOLUTE
+ OCI_FETCH_RELATIVE)],
+ ora_exe_modes => [ qw(OCI_STMT_SCROLLABLE_READONLY)],
);
- @EXPORT_OK = qw(ORA_OCI SQLCS_IMPLICIT SQLCS_NCHAR ora_env_var
ora_cygwin_set_env);
+ @EXPORT_OK = qw(OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST
OCI_FETCH_LAST OCI_FETCH_PRIOR
+ OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE ORA_OCI
SQLCS_IMPLICIT SQLCS_NCHAR ora_env_var ora_cygwin_set_env);
#unshift @EXPORT_OK, 'ora_cygwin_set_env' if $^O eq 'cygwin';
- Exporter::export_ok_tags(qw(ora_types ora_session_modes));
+ Exporter::export_ok_tags(qw(ora_types ora_session_modes ora_fetch_orient
ora_exe_modes));
my $Revision = substr(q$Revision: 1.103 $, 10);
@@ -68,7 +73,9 @@
DBD::Oracle::db->install_method("ora_lob_length");
DBD::Oracle::db->install_method("ora_nls_parameters");
DBD::Oracle::db->install_method("ora_can_unicode");
-
+ DBD::Oracle::st->install_method("ora_fetch_scroll");
+ DBD::Oracle::st->install_method("ora_scroll_position");
+
$drh;
}
@@ -874,7 +881,7 @@
$$hash_of_arrays{$p_id} = $value_array;
return ora_bind_param_inout_array($sth, $p_id, $value_array,$maxlen,
$attr);
1;
-
+
}
@@ -929,7 +936,7 @@
ora_placeholders => undef,
ora_auto_lob => undef,
ora_check_sql => undef
- };
+ };
}
}
@@ -1193,7 +1200,7 @@
ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE
ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_NTY
ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE
- SQLT_INT SQLT_FLT XMLType
+ SQLT_INT SQLT_FLT
=item SQLCS_IMPLICIT
@@ -1210,7 +1217,6 @@
bind type for ORA_NUMBER_TABLE. See notes about ORA_NUMBER_TABLE elsewhere
in this document
-
=item ORA_OCI
Oracle doesn't provide a formal API for determining the exact version
@@ -1455,6 +1461,18 @@
See L</Prepare postponed till execute> for more information.
+=item ora_exe_mode
+
+This will set the execute mode of the current statement. Presently only one
mode is supported;
+
+ OCI_STMT_SCROLLABLE_READONLY = 'scrollable results sets'
+
+=item ora_prefetch_memory
+
+Sets the memory level for top level rows to be prefetched. Rows up to the
specified top level row
+count C<RowCacheSize> are fetched if it occupies no more than the specified
memory usage limit. The default value is 0,
+which means that memory size is not included in computing the number of rows
to prefetch.
+
=back
=head2 Placeholder Binding Attributes
@@ -1482,7 +1500,7 @@
Additional values when DBD::Oracle was built using OCI 8 and later:
- ORA_CLOB, ORA_BLOB, ORA_NTY, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE, XMLType
+ ORA_CLOB, ORA_BLOB, ORA_NTY, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE
See L</Binding Cursors> for the correct way to use ORA_RSET.
@@ -2446,6 +2464,218 @@
Set L</ora_check_sql> to 0 in prepare() to enable this behaviour.
+=head1 Scrollable Cursors
+
+Oracle supports the concept of a 'Scrollable Cursor' which is defined as a
'result set' where
+the rows can be fetched either sequentially or non-sequentially. One can fetch
rows forward,
+backwards, from any given position or the n-th row from the current position
in the 'result set'.
+
+Rows are numbered sequentially starting at one and client-side caching of the
partial or entire result set
+can improve performance by limiting round trips to the server.
+
+Oracle does not support DML type operations with scrollable cursors so you are
limited
+to simple 'Select' operations only. As well you can not use this functionality
with remote
+mapped queries or if the LONG datatype is part of the select list.
+
+However, Lobs, Clobs, and Blobs do work.
+
+Only use scrollable cursors if you really have a good reason to. They do use
up considerable
+more server and client resources and have poorer response times than
non-scrolling cursors.
+
+=head2 Enabling Scrollable Cursors
+
+To enable this functionality you must first import the "Fetch Orientation" and
the 'Execution Mode' constants by using
+
+ use DBD::Oracle qw(:ora_fetch_orient,:ora_exe_modes);
+
+Which will import the following fetch orientation constants;
+
+ OCI_FETCH_CURRENT - gets the current row.
+ OCI_FETCH_NEXT - gets the next row from the current position.
+ OCI_FETCH_FIRST - gets the first row in the 'result set'
+ OCI_FETCH_LAST - gets the last row in the 'result set'
+ OCI_FETCH_PRIOR - positions the result set on the previous row from the
current row in the 'result set'
+ OCI_FETCH_ABSOLUTE - will fetch a row number in the result set using
absolute positioning
+ OCI_FETCH_RELATIVE - will fetch a row number in the result set using
relative positioning
+
+and the following Execution Mode constant;
+
+ OCI_STMT_SCROLLABLE_READONLY - Required to make the result set scrollable.
+
+Next you will have to tell DBD::Oracle that you will be using scrolling by
setting the ora_exe_mode attribute on the
+statement handle to 'OCI_STMT_SCROLLABLE_READONLY' with the prepare method;
+
+ $sth=$dbh->prepare($sql,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+
+When the statement is executed you will then be able to use ora_fetch_scroll
method to get your results
+or you can still use any of the other fetch methods but with a poorer response
time than if you used a
+non-scrolling cursor.
+
+=head2 Scrollable Cursor Methods
+
+The following driver-specific methods are used with scrollable cursors.
+
+=over 4
+
+=item ora_fetch_scroll
+
+ my $value = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset);
+
+Works the same as fetchrow_array method however, one passes in a "Fetch
Orientation" constant and a fetch_offset
+value which will then determine the row that will be fetched. It returns the
row as a list containing the field values.
+Null fields are returned as undef values in the list.
+
+=item ora_scroll_position
+
+ my $position = $sth->ora_scroll_position();
+
+This method returns the current position in the result set.
+
+=head2 Scrollable Cursor Usage
+
+Given a simple code like this:
+
+ use DBI;
+ use DBD::Oracle qw(:ora_types);
+ my $dbh = DBI->connect($dsn, $dbuser, '');
+ my $sql = "select id,
+ first_name,
+ last_name
+ from employee";
+ my $sth=$dbh->prepare($sql,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY});
+ $sth->execute();
+ my $value;
+
+and one assumes that the number of rows returned from the query 20, the code
snippets below will illustrate the use of ora_fetch_scroll
+method.
+
+=over 4
+
+=item Fetching the Current Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This will get the current row of the result set, which in this case would be
1, print the values for the fields in the row
+and then print the current scroll position which would still be 1. With this
fetch constant the value for fetch offset is ignored.
+
+=item Fetching the Next Row
+
+ for(my i=0;i<=3;i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This snippet will get the next four rows from the result (2,3,4,5) set and
print them and then print the position which will be 5,
+Again the value for fetch offset is ignored for this fetch constant.
+
+=item Fetching the First Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This snippet will move the pointer back to the first row (1) and print out its
values again. The position value will be 1
+in this case. Again the value for fetch offset is ignored for this fetch
constant.
+
+=item Fetching the Last Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This snippet will move the pointer to the last row in the result set (20) and
print out its values. The position value will be 20
+in this case. The value for fetch offset is ignored for this fetch constant.
This is also way to determine the number of rows in
+the record set, however if you result set is large response time can be high.
+
+=item Fetching the Prior Row
+
+ for(my $i=0;$i<=3;i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This snippet will get the four prior rows from the result set (19,18,17,16)
and print them and then print
+the position which will be 16. Again the value for fetch offset is ignored for
this fetch constant.
+
+=item Fetching the 10th Row
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,10);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This snippet will move the pointer to row 10 and print out its values. The
position value will be 10
+in this case. With this fetch constant the fetch offset value is the row
number to fetch.
+
+=item Fetching the 10th to 14th Row
+
+ for(my $i=10;$i<15;i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+In this snippet the OCI_FETCH_ABSOLUTE constant is used with the offset
variable $i to get rows 10,11,12,13, and 14
+from the record set and print them out. The position value will be 14 at the
end of this code.
+
+=item Fetching the 14th to 10th Row
+
+ for(my $i=14;$i>9;i--){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ }
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+In this snippet the OCI_FETCH_ABSOLUTE constant is used with the offset
variable $i to get rows 14,13,12,11, and 10
+from the record set and print them out. The position value will be 10 at the
end of this code.
+
+=item Fetching the 5th Row From the Present position
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,5);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This snippet will jump forward in the record set by the offset value of '5',
from row 10 to row 15, and print out its values.
+The position value will be 15 at this point. With this fetch constant the
fetch offset value is the relative row from the current row to fetch.
+
+=item Fetching the 9th Row Prior From the Present position
+
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-9);
+ print "id=".$value->[0].", First Name=".$value->[1].", Last
Name=".$value->[2]."\n";
+ print "current scroll position=".$sth->ora_scroll_position()."\n";
+
+This snippet will jump backward in the record set by the offset value of '-9',
from row 15 to row 6 and print out its values.
+The position value will be 6 at this point.
+
+=item Relative Fetching Equivalents
+
+When using OCI_FETCH_RELATIVE with a fetch offset equal to 0 will get the
current row which is the same as a OCI_FETCH_CURRENT fetch.
+When using OCI_FETCH_RELATIVE with a fetch offset equal to 1 will get the next
row which is the same as a OCI_FETCH_NEXT fetch.
+When using OCI_FETCH_RELATIVE with a fetch offset equal to -1 will get the
prior row which is the same as a OCI_FETCH_PRIOR fetch.
+
+=item Use Finish
+
+ $sth->finish();
+
+When using scrollable cursors it is required that you use the $sth->finish()
method when you are done with the cursor as this type of
+cursor has to be explicitly canceled on the server. If you do not do this you
may cause resource problems on your database.
+
+=head2 Prefetching Rows
+
+One can override the DBD::Oracle's default pre-fetch values by using the DBI
database handle attribute C<RowCacheSize> and or the
+Prepare Attribute 'ora_prefetch_memory'. Tweaking these values may yield
improved performance.
+
+ $dbh->{RowCacheSize} = 10;
+
$sth=$dbh->prepare($sql,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>10000});
+
+In the above example 10 rows will be prefetched up to a maximum of 10000 bytes
of data. A good RowCacheSize value for a scrollable cursor
+is about 20% of expected size of the record set. If the ora_prefetch_memory is
0 or not present then memory size is not included
+in computing the number of rows to prefetch otherwise the number of rows will
be limited to memory size.
+
+
=head1 Handling LOBs
=head2 Simple Usage
@@ -2463,9 +2693,9 @@
To correct for this you must use an SQL UPDATE statement to reset the
LOB column to a non-NULL (or empty) value with an SQL like this;
- UPDATE lob_example
- SET bindata=EMPTY_BLOB()
- WHERE bindata IS NULL.
+ UPDATE lob_example
+ SET bindata=EMPTY_BLOB()
+ WHERE bindata IS NULL.
When fetching LOBs they are, by default, made to look just like LONGs and
are subject to the LongReadLen and LongTruncOk attributes. Note that
@@ -3221,7 +3451,7 @@
Any NULL values found in the embedded object will be returned as 'undef'.
-=head1 Support for Insert of XMLType
+=head1 Support for Insert of XMLType (ORA_NTY)
Inserting large XML data sets into tables with XMLType fields is now supported
by DBD::Oracle. The only special
requirement is the use of bind_param() with an attribute hash parameter that
specifies ora_type as ORA_NTY. For
Modified: dbd-oracle/trunk/Oracle.xs
==============================================================================
--- dbd-oracle/trunk/Oracle.xs (original)
+++ dbd-oracle/trunk/Oracle.xs Wed Mar 19 08:27:23 2008
@@ -16,23 +16,41 @@
ORA_LONG = 8
ORA_ROWID = 11
ORA_DATE = 12
- ORA_RAW = 23
+ ORA_RAW = 23
ORA_LONGRAW = 24
ORA_CHAR = 96
ORA_CHARZ = 97
ORA_MLSLABEL = 105
- ORA_NTY = 108
+ ORA_NTY = 108
ORA_CLOB = 112
ORA_BLOB = 113
ORA_RSET = 116
ORA_VARCHAR2_TABLE = ORA_VARCHAR2_TABLE
ORA_NUMBER_TABLE = ORA_NUMBER_TABLE
- ORA_SYSDBA = 0x0002
- ORA_SYSOPER = 0x0004
- SQLCS_IMPLICIT = SQLCS_IMPLICIT
- SQLCS_NCHAR = SQLCS_NCHAR
- SQLT_INT = SQLT_INT
- SQLT_FLT = SQLT_FLT
+ ORA_SYSDBA = 0x0002
+ ORA_SYSOPER = 0x0004
+ SQLCS_IMPLICIT = SQLCS_IMPLICIT
+ SQLCS_NCHAR = SQLCS_NCHAR
+ SQLT_INT = SQLT_INT
+ SQLT_FLT = SQLT_FLT
+ OCI_BATCH_MODE = 0x01
+ OCI_EXACT_FETCH = 0x02
+ OCI_KEEP_FETCH_STATE = 0x04
+ OCI_DESCRIBE_ONLY = 0x10
+ OCI_COMMIT_ON_SUCCESS = 0x20
+ OCI_NON_BLOCKING = 0x40
+ OCI_BATCH_ERRORS = 0x80
+ OCI_PARSE_ONLY = 0x100
+ OCI_SHOW_DML_WARNINGS = 0x400
+ OCI_STMT_SCROLLABLE_READONLY = 0x08
+ OCI_FETCH_CURRENT = OCI_FETCH_CURRENT
+ OCI_FETCH_NEXT = OCI_FETCH_NEXT
+ OCI_FETCH_FIRST = OCI_FETCH_FIRST
+ OCI_FETCH_LAST = OCI_FETCH_LAST
+ OCI_FETCH_PRIOR = OCI_FETCH_PRIOR
+ OCI_FETCH_ABSOLUTE = OCI_FETCH_ABSOLUTE
+ OCI_FETCH_RELATIVE = OCI_FETCH_RELATIVE
+
CODE:
if (!ix) {
if (!name) name = GvNAME(CvGV(cv));
@@ -77,6 +95,40 @@
MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st
+
+void
+ora_scroll_position(sth)
+ SV * sth
+ PREINIT:
+ D_imp_sth(sth);
+ CODE:
+ {
+ XSRETURN_IV( imp_sth->fetch_position);
+}
+
+void
+ora_fetch_scroll(sth,fetch_orient,fetch_offset)
+ SV * sth
+ IV fetch_orient
+ IV fetch_offset
+ PREINIT:
+ D_imp_sth(sth);
+ CODE:
+ {
+ AV *av;
+ /* SV **svp;
+ if (fetch_orient){
+ fetch_orient = OCI_FETCH_NEXT;
+ }
+ sb4 fetch_offset = 0;
+ DBD_ATTRIB_GET_IV( attribs, "fetch_orient",12, svp, fetch_orient);
+ DBD_ATTRIB_GET_IV( attribs, "fetch_offset",12, svp, fetch_offset);*/
+ imp_sth->fetch_orient=fetch_orient;
+ imp_sth->fetch_offset=fetch_offset;
+ av = dbd_st_fetch(sth,imp_sth);
+ ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
+}
+
void
ora_bind_param_inout_array(sth, param, av_ref, maxlen, attribs)
SV * sth
@@ -110,7 +162,7 @@
ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE,
maxlen)
? &sv_yes : &sv_no;
}
-
+
void
ora_fetch(sth)
SV * sth
@@ -227,7 +279,7 @@
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
ST(0) = &sv_undef;
return;
- }
+ }
#ifdef OCI_ATTR_CHARSET_ID
/* Effectively only used so AL32UTF8 works properly */
OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid,
status );
@@ -429,6 +481,6 @@
dbd_init_oci(DBIS) ;
dbd_init_oci_drh(imp_drh) ;
-
-
+
+
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Wed Mar 19 08:27:23 2008
@@ -955,30 +955,32 @@
retsv = boolSV(DBIc_has(imp_dbh,DBIcf_AutoCommit));
}
else if (kl==12 && strEQ(key, "RowCacheSize")) {
- retsv = newSViv(imp_dbh->RowCacheSize);
+ retsv = newSViv(imp_dbh->RowCacheSize);
}
else if (kl==22 && strEQ(key, "ora_max_nested_cursors")) {
- retsv = newSViv(imp_dbh->max_nested_cursors);
+ retsv = newSViv(imp_dbh->max_nested_cursors);
}
else if (kl==11 && strEQ(key, "ora_ph_type")) {
- retsv = newSViv(imp_dbh->ph_type);
+ retsv = newSViv(imp_dbh->ph_type);
}
else if (kl==13 && strEQ(key, "ora_ph_csform")) {
- retsv = newSViv(imp_dbh->ph_csform);
+ retsv = newSViv(imp_dbh->ph_csform);
}
else if (kl==22 && strEQ(key, "ora_parse_error_offset")) {
retsv = newSViv(imp_dbh->parse_error_offset);
}
if (!retsv)
- return Nullsv;
+ return Nullsv;
if (cacheit) { /* cache for next time (via DBI quick_FETCH) */
- SV **svp = hv_fetch((HV*)SvRV(dbh), key, kl, 1);
- sv_free(*svp);
- *svp = retsv;
- (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it */
+ SV **svp = hv_fetch((HV*)SvRV(dbh), key, kl, 1);
+ sv_free(*svp);
+ *svp = retsv;
+ (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it
*/
}
+
if (retsv == &sv_yes || retsv == &sv_no)
- return retsv; /* no need to mortalize yes or no */
+ return retsv; /* no need to mortalize yes or no */
+
return sv_2mortal(retsv);
}
@@ -2859,18 +2861,20 @@
dTHR;
dTHX;
ub4 row_count = 0;
- int debug = DBIS->debug;
+ int debug = DBIS->debug;
int outparams = (imp_sth->out_params_av) ?
AvFILL(imp_sth->out_params_av)+1 : 0;
-
D_imp_dbh_from_sth;
sword status;
int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
+ ub4 exe_mode = imp_sth->exe_mode;
+
if (debug >= 2)
- PerlIO_printf(DBILOGFP, " dbd_st_execute %s (out%d, lob%d)...\n",
+ PerlIO_printf(DBILOGFP, " dbd_st_execute %s (out%d, lob%d)...\n",
oci_stmt_type_name(imp_sth->stmt_type), outparams,
imp_sth->has_lobs);
- /* Don't attempt execute for nested cursor. It would be meaningless,
+
+ /* Don't attempt execute for nested cursor. It would be meaningless,
and Oracle code has been seen to core dump */
if (imp_sth->nested_cursor) {
oci_error(sth, NULL, OCI_ERROR,
@@ -2932,15 +2936,19 @@
}
}
}
-
- OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
- (ub4)(is_select ? 0 : 1),
- 0, 0, 0,
- /* we don't AutoCommit on select so LOB locators work */
- (ub4)((DBIc_has(imp_dbh,DBIcf_AutoCommit) && !is_select)
- ? OCI_COMMIT_ON_SUCCESS : OCI_DEFAULT),
- status);
-
+
+
+ if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && !is_select) {
+ imp_sth->exe_mode=OCI_COMMIT_ON_SUCCESS;
+ /* we don't AutoCommit on select so LOB locators work */
+ }
+
+
+
+ OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp,
imp_sth->errhp,
+ (ub4)(is_select ? 0 : 1),
+ 0, 0, 0,(ub4)imp_sth->exe_mode,status);
+
if (status != OCI_SUCCESS) { /* may be OCI_ERROR or
OCI_SUCCESS_WITH_INFO etc */
/* we record the error even for OCI_SUCCESS_WITH_INFO */
oci_error(sth, imp_sth->errhp, status,
ora_sql_error(imp_sth,"OCIStmtExecute"));
@@ -3396,7 +3404,7 @@
PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_finish\n");
if (!DBIc_ACTIVE(imp_sth))
- return 1;
+ return 1;
/* Cancel further fetches from this cursor. */
/* We don't close the cursor till DESTROY (dbd_st_destroy). */
@@ -3411,16 +3419,22 @@
}
if (dirty) /* don't walk on the wild side */
- return 1;
+ return 1;
if (!DBIc_ACTIVE(imp_dbh)) /* no longer connected */
- return 1;
+ return 1;
+ /*fetching on a cursor with row =0 will explicitly free any
+ server side resources this is what the next statment does,
+ not sure if we need this for non scrolling cursors they should die on
+ a OER(1403) no records)*/
+
OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp, 0,
- OCI_FETCH_NEXT, OCI_DEFAULT, status);
+ OCI_FETCH_NEXT,0, status);
+
if (status != OCI_SUCCESS && status != OCI_SUCCESS_WITH_INFO) {
- oci_error(sth, imp_sth->errhp, status, "Finish OCIStmtFetch");
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "Finish OCIStmtFetch");
+ return 0;
}
return 1;
}
Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Wed Mar 19 08:27:23 2008
@@ -46,6 +46,7 @@
int parse_error_offset; /* position in statement of last error */
int max_nested_cursors; /* limit on cached nested cursors per stmt */
int array_chunk_size; /* the max size for an array bind */
+
};
#define DBH_DUP_OFF sizeof(dbih_dbc_t)
@@ -55,21 +56,21 @@
typedef struct lob_refetch_st lob_refetch_t; /* Define sth implementor data
structure */
-
+/*statement structure */
struct imp_sth_st {
dbih_stc_t com; /* MUST be first element in structure */
void *(*get_oci_handle) _((imp_sth_t *imp_sth, int handle_type, int
flags));
- OCIEnv *envhp; /* copy of dbh pointer */
- OCIError *errhp; /* copy of dbh pointer */
- OCIServer *srvhp; /* copy of dbh pointer */
- OCISvcCtx *svchp; /* copy of dbh pointer */
- OCIStmt *stmhp; /* oci statement handle */
- OCIDescribe *dschp; /* oci describe handle */
- ub2 stmt_type; /* OCIAttrGet OCI_ATTR_STMT_TYPE
*/
- U16 auto_lob;
- int has_lobs; /* Statement has boud LOBS*/
+ OCIEnv *envhp; /* copy of dbh pointer */
+ OCIError *errhp; /* copy of dbh pointer */
+ OCIServer *srvhp; /* copy of dbh pointer */
+ OCISvcCtx *svchp; /* copy of dbh pointer */
+ OCIStmt *stmhp; /* oci statement handle */
+ OCIDescribe *dschp; /* oci describe handle */
+ ub2 stmt_type; /* OCIAttrGet
OCI_ATTR_STMT_TYPE */
+ U16 auto_lob; /* use auto lobs*/
+ int has_lobs; /* Statement has bound LOBS*/
lob_refetch_t *lob_refetch;
int nested_cursor; /* cursors fetched from SELECTs */
@@ -98,7 +99,14 @@
int est_width; /* est'd avg row width on-the-wire */
/* (In/)Out Parameter Details */
bool has_inout_params;
-
+ /* execute mode*/
+ /* will be using this alot later me thinks */
+ ub4 exe_mode;
+ /* fetch scrolling values */
+ int fetch_orient;
+ int fetch_offset;
+ int fetch_position;
+ int prefetch_memory; /* OCI_PREFETCH_MEMORY*/
};
#define IMP_STH_EXECUTING 0x0001
Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Wed Mar 19 08:27:23 2008
@@ -33,6 +33,7 @@
imp_drh->ora_trunc = perl_get_sv("Oraperl::ora_trunc", GV_ADDMULTI);
imp_drh->ora_cache = perl_get_sv("Oraperl::ora_cache", GV_ADDMULTI);
imp_drh->ora_cache_o = perl_get_sv("Oraperl::ora_cache_o", GV_ADDMULTI);
+
}
@@ -111,6 +112,29 @@
return SvPV(sv,na);
}
+/*used to look up the name of a fetchtype constant
+ used only for debugging */
+char *
+oci_fetch_options(ub4 fetchtype)
+{
+ dTHX;
+ SV *sv;
+ switch (fetchtype) {
+ /* fetch options */
+ case OCI_FETCH_CURRENT: return "OCI_FETCH_CURRENT";
+ case OCI_FETCH_NEXT: return "OCI_FETCH_NEXT";
+ case OCI_FETCH_FIRST: return "OCI_FETCH_FIRST";
+ case OCI_FETCH_LAST: return "OCI_FETCH_LAST";
+ case OCI_FETCH_PRIOR: return "OCI_FETCH_PRIOR";
+ case OCI_FETCH_ABSOLUTE: return "OCI_FETCH_ABSOLUTE";
+ case OCI_FETCH_RELATIVE: return "OCI_FETCH_RELATIVE";
+ }
+ sv = sv_2mortal(newSViv((IV)fetchtype));
+ return SvPV(sv,na);
+}
+
+
+
static sb4
oci_error_get(OCIError *errhp, sword status, char *what, SV *errstr, int debug)
@@ -254,17 +278,17 @@
{
dTHX;
D_imp_dbh_from_sth;
- sword status = 0;
- ub4 oparse_lng = 1; /* auto v6 or v7 as suits db connected to */
- int ora_check_sql = 1; /* to force a describe to check SQL */
- IV ora_placeholders = 1; /* find and handle placeholders */
+ sword status = 0;
+ ub4 oparse_lng = 1; /* auto v6 or v7 as suits db connected
to */
+ int ora_check_sql = 1; /* to force a describe to check SQL */
+ IV ora_placeholders = 1; /* find and handle placeholders */
/* XXX we set ora_check_sql on for now to force setup of the */
/* row cache. Change later to set up row cache using just a */
/* a memory size, perhaps also default $RowCacheSize to a */
/* negative value. OCI_ATTR_PREFETCH_MEMORY */
if (!DBIc_ACTIVE(imp_dbh)) {
- oci_error(sth, NULL, OCI_ERROR, "Database disconnected");
+ oci_error(sth, NULL, OCI_ERROR, "Database disconnected");
return 0;
}
@@ -274,30 +298,37 @@
imp_sth->get_oci_handle = oci_st_handle;
if (DBIc_COMPAT(imp_sth)) {
- static SV *ora_pad_empty;
- if (!ora_pad_empty) {
- ora_pad_empty= perl_get_sv("Oraperl::ora_pad_empty", GV_ADDMULTI);
- if (!SvOK(ora_pad_empty) && getenv("ORAPERL_PAD_EMPTY"))
- sv_setiv(ora_pad_empty, atoi(getenv("ORAPERL_PAD_EMPTY")));
- }
- imp_sth->ora_pad_empty = (SvOK(ora_pad_empty)) ? SvIV(ora_pad_empty) :
0;
+ static SV *ora_pad_empty;
+ if (!ora_pad_empty) {
+ ora_pad_empty= perl_get_sv("Oraperl::ora_pad_empty",
GV_ADDMULTI);
+ if (!SvOK(ora_pad_empty) && getenv("ORAPERL_PAD_EMPTY"))
+ sv_setiv(ora_pad_empty,
atoi(getenv("ORAPERL_PAD_EMPTY")));
+ }
+ imp_sth->ora_pad_empty = (SvOK(ora_pad_empty)) ?
SvIV(ora_pad_empty) : 0;
}
imp_sth->auto_lob = 1;
- if (attribs) {
- SV **svp;
- IV ora_auto_lob = 1;
- DBD_ATTRIB_GET_IV( attribs, "ora_parse_lang", 14, svp, oparse_lng);
- DBD_ATTRIB_GET_IV( attribs, "ora_placeholders", 16, svp,
ora_placeholders);
- DBD_ATTRIB_GET_IV( attribs, "ora_auto_lob", 12, svp, ora_auto_lob);
- imp_sth->auto_lob = (ora_auto_lob) ? 1 : 0;
- /* ora_check_sql only works for selects owing to Oracle behaviour */
- DBD_ATTRIB_GET_IV( attribs, "ora_check_sql", 13, svp, ora_check_sql);
- }
+ imp_sth->exe_mode = OCI_DEFAULT;
+
+ if (attribs) {
+ SV **svp;
+ IV ora_auto_lob = 1;
+ DBD_ATTRIB_GET_IV( attribs, "ora_parse_lang", 14, svp,
oparse_lng);
+ DBD_ATTRIB_GET_IV( attribs, "ora_placeholders", 16, svp,
ora_placeholders);
+ DBD_ATTRIB_GET_IV( attribs, "ora_auto_lob", 12, svp,
ora_auto_lob);
+ imp_sth->auto_lob = (ora_auto_lob) ? 1 : 0;
+ /* ora_check_sql only works for selects owing to Oracle
behaviour */
+ DBD_ATTRIB_GET_IV( attribs, "ora_check_sql", 13, svp,
ora_check_sql);
+ DBD_ATTRIB_GET_IV( attribs, "ora_exe_mode", 12, svp,
imp_sth->exe_mode);
+ DBD_ATTRIB_GET_IV( attribs, "ora_prefetch_memory", 19, svp,
imp_sth->prefetch_memory);
+
+ }
- /* scan statement for '?', ':1' and/or ':foo' style placeholders */
+
+
+ /* scan statement for '?', ':1' and/or ':foo' style placeholders
*/
if (ora_placeholders)
- dbd_preparse(imp_sth, statement);
+ dbd_preparse(imp_sth, statement);
else imp_sth->statement = savepv(statement);
imp_sth->envhp = imp_dbh->envhp;
@@ -306,11 +337,11 @@
imp_sth->svchp = imp_dbh->svchp;
switch(oparse_lng) {
- case 0: /* old: calls for V6 syntax - give them V7 */
- case 2: /* old: calls for V7 syntax */
- case 7: oparse_lng = OCI_V7_SYNTAX; break;
- case 8: oparse_lng = OCI_V8_SYNTAX; break;
- default: oparse_lng = OCI_NTV_SYNTAX; break;
+ case 0: /* old: calls for V6 syntax - give them V7 */
+ case 2: /* old: calls for V7 syntax */
+ case 7: oparse_lng = OCI_V7_SYNTAX; break;
+ case 8: oparse_lng = OCI_V8_SYNTAX; break;
+ default: oparse_lng = OCI_NTV_SYNTAX; break;
}
OCIHandleAlloc_ok(imp_dbh->envhp, &imp_sth->stmhp, OCI_HTYPE_STMT, status);
@@ -340,7 +371,7 @@
}
else {
/* set initial cache size by memory */
- /* [I'm not now sure why this is here - from a patch sometime ago - Tim]
*/
+ /* [I'm not now sure why this is here - from a patch sometime ago -
Tim]*/
ub4 cache_mem;
IV cache_mem_iv;
D_imp_dbh_from_sth ;
@@ -1264,30 +1295,31 @@
{
dTHX;
if (has_longs) /* override/disable caching */
- cache_rows = 1; /* else read_blob can't work */
+ cache_rows = 1; /* else read_blob can't work
*/
else
- if (cache_rows == 0) { /* automatically size the cache */
+ if (cache_rows == 0) { /* automatically size the cache
*/
- /* Oracle packets on ethernet have max size of around 1460. */
- /* We'll aim to fill our row cache with around 10 per go. */
- /* Using 10 means any 'runt' packets will have less impact. */
- int txfr_size = 10 * 1460; /* desired transfer/cache size */
-
- /* Use guessed average on-the-wire row width calculated above & */
- /* add in overhead of 5 bytes per field plus 8 bytes per row. */
- /* The n*5+8 was determined by studying SQL*Net v2 packets. */
- /* It could probably benefit from a more detailed analysis. */
- est_width += num_fields*5 + 8;
-
- cache_rows = txfr_size / est_width; /* (maybe 1 or 0) */
-
- /* To ensure good performance with large rows (near or larger */
- /* than our target transfer size) we set a minimum cache size. */
- if (cache_rows < 6) /* is cache a 'useful' size? */
- cache_rows = (cache_rows > 0) ? 6 : 4;
- }
- if (cache_rows > 32767) /* keep within Oracle's limits */
- cache_rows = 32767;
+ /* Oracle packets on ethernet have max size of around
1460. */
+ /* We'll aim to fill our row cache with around 10 per
go. */
+ /* Using 10 means any 'runt' packets will have less
impact. */
+ int txfr_size = 10 * 1460; /* desired
transfer/cache size */
+
+ /* Use guessed average on-the-wire row width calculated
above & */
+ /* add in overhead of 5 bytes per field plus 8 bytes
per row. */
+ /* The n*5+8 was determined by studying SQL*Net v2
packets. */
+ /* It could probably benefit from a more detailed
analysis. */
+ est_width += num_fields*5 + 8;
+
+ cache_rows = txfr_size / est_width; /* (maybe
1 or 0) */
+
+ /* To ensure good performance with large rows (near or
larger */
+ /* than our target transfer size) we set a minimum
cache size. */
+ if (cache_rows < 6) /* is cache a 'useful' size?
*/
+ cache_rows = (cache_rows > 0) ? 6 : 4;
+ }
+
+ if (cache_rows > 10000000) /* keep within Oracle's limits */
+ cache_rows = 10000000; /* seems it was ub2 at one time now ub4
this number is arbitary on my part*/
return cache_rows;
}
@@ -1697,6 +1729,8 @@
+
+
static int /* --- Setup the row cache for this sth --- */
sth_set_row_cache(SV *h, imp_sth_t *imp_sth, int max_cache_rows, int
num_fields, int has_longs)
{
@@ -1704,57 +1738,75 @@
D_imp_dbh_from_sth;
D_imp_drh_from_dbh;
int num_errors = 0;
- ub4 cache_mem, cache_rows;
+ ub4 cache_mem=0;
+ ub4 cache_rows=10000;/* set high so memory is the limit */
sword status;
- /* number of rows to cache */
+ /* reworked this is little so the user can set up his own cache
+ basically if rowcachesize or prefetch_mem is set it uses those values
+ otherwise it does it itself
+ no sure what happens in the last case but I lwft it in for now
+ Also I think in later version of OCI this call does not really do
anything
+ */
+
+ /* number of rows to cache if using oraperl */
if (SvOK(imp_drh->ora_cache_o)) imp_sth->cache_rows =
SvIV(imp_drh->ora_cache_o);
else if (SvOK(imp_drh->ora_cache)) imp_sth->cache_rows =
SvIV(imp_drh->ora_cache);
- else imp_sth->cache_rows =
imp_dbh->RowCacheSize;
-
- if (imp_sth->cache_rows >= 0) { /* set cache size by row count */
- /* imp_sth->est_width needs to be set */
- cache_mem = 0; /* so memory isn't the limit */
- cache_rows = calc_cache_rows(imp_sth->cache_rows,
- (int)num_fields, imp_sth->est_width, has_longs);
- if (max_cache_rows && cache_rows > (unsigned long) max_cache_rows)
- cache_rows = max_cache_rows;
- imp_sth->cache_rows = cache_rows; /* record updated value */
-
- OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_mem, sizeof(cache_mem), OCI_ATTR_PREFETCH_MEMORY,
- imp_sth->errhp, status);
- OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_rows, sizeof(cache_rows), OCI_ATTR_PREFETCH_ROWS,
- imp_sth->errhp, status);
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, "OCIAttrSet
OCI_ATTR_PREFETCH_ROWS");
- ++num_errors;
- }
+
+
+ if (imp_dbh->RowCacheSize || imp_sth->prefetch_memory){
+ /*user set values */
+ cache_rows =imp_dbh->RowCacheSize;
+ cache_mem =imp_sth->prefetch_memory;
+
+ } else if (imp_sth->cache_rows >= 0) { /* set cache size by row count
*/
+
+ /* imp_sth->est_width needs to be set */
+ cache_mem = 0; /* so memory isn't the limit */
+
+ cache_rows =
calc_cache_rows(imp_sth->cache_rows,(int)num_fields, imp_sth->est_width,
has_longs);
+
+ if (max_cache_rows && cache_rows > (unsigned long)
max_cache_rows)
+ cache_rows = max_cache_rows;
+
+ imp_sth->cache_rows = cache_rows; /* record updated value
*/
+
}
else { /* set cache size by memory */
- cache_mem = -imp_sth->cache_rows; /* cache_mem always +ve here */
- cache_rows = 100000; /* set high so memory is the limit */
- if (max_cache_rows && cache_rows > (unsigned long) max_cache_rows) {
- cache_rows = max_cache_rows;
- imp_sth->cache_rows = cache_rows; /* record updated value only if
max_cache_rows */
+ /* not sure if we ever reach this*/
+ cache_mem = -imp_sth->cache_rows; /* cache_mem always +ve here
*/
+ if (max_cache_rows && cache_rows > (unsigned long)
max_cache_rows) {
+ cache_rows = max_cache_rows;
+ imp_sth->cache_rows = cache_rows; /* record updated value
only if max_cache_rows */
+ }
+
+ }
+
+
+ OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
+ &cache_mem, sizeof(cache_mem),
OCI_ATTR_PREFETCH_MEMORY,
+ imp_sth->errhp, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status,
+ "OCIAttrSet
OCI_ATTR_PREFETCH_ROWS/OCI_ATTR_PREFETCH_MEMORY");
+ ++num_errors;
}
+
OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_rows, sizeof(cache_rows), OCI_ATTR_PREFETCH_ROWS,
- imp_sth->errhp, status);
- OCIAttrSet_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT,
- &cache_mem, sizeof(cache_mem), OCI_ATTR_PREFETCH_MEMORY,
- imp_sth->errhp, status);
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status,
- "OCIAttrSet OCI_ATTR_PREFETCH_ROWS/OCI_ATTR_PREFETCH_MEMORY");
+ &cache_rows, sizeof(cache_rows),
OCI_ATTR_PREFETCH_ROWS,
+ imp_sth->errhp, status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIAttrSet
OCI_ATTR_PREFETCH_ROWS");
++num_errors;
}
- }
+
if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
+ PerlIO_printf(DBILOGFP,
" row cache OCI_ATTR_PREFETCH_ROWS %lu, OCI_ATTR_PREFETCH_MEMORY
%lu\n",
(unsigned long) (cache_rows), (unsigned long) (cache_mem));
+
return num_errors;
}
@@ -2230,9 +2282,12 @@
fbh->disize += 1; /* allow for null terminator */
/* dbsize can be zero for 'select NULL ...' */
+
imp_sth->t_dbsize += fbh->dbsize;
+
if (!avg_width)
avg_width = fbh->dbsize;
+
est_width += avg_width;
if (DBIS->debug >= 2)
@@ -2242,9 +2297,8 @@
imp_sth->est_width = est_width;
sth_set_row_cache(h, imp_sth,
- (nested_cursors) ? imp_dbh->max_nested_cursors / nested_cursors : 0,
- (int)num_fields, has_longs
- );
+ (nested_cursors) ? imp_dbh->max_nested_cursors / nested_cursors
: 0,
+ (int)num_fields, has_longs );
/* Initialise cache counters */
imp_sth->in_cache = 0;
@@ -2371,8 +2425,24 @@
if (DBIS->debug >= 3){
PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields...\n",
DBIc_NUM_FIELDS(imp_sth));
}
+ if (imp_sth->fetch_orient) {
+ if (imp_sth->exe_mode!=OCI_STMT_SCROLLABLE_READONLY)
+ croak ("attempt to use a scrollable cursor
without first setting ora_exe_mode to OCI_STMT_SCROLLABLE_READONLY\n") ;
+
+ if (DBIS->debug >= 4)
+ PerlIO_printf(DBILOGFP," Scrolling Fetch,
postion before fetch=%d, Orientation = %s , Fetchoffset =%d\n",
+
imp_sth->fetch_position,oci_fetch_options(imp_sth->fetch_orient),imp_sth->fetch_offset);
+
+ OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp,1,
imp_sth->fetch_orient,imp_sth->fetch_offset, status);
+ OCIAttrGet_stmhp_stat(imp_sth,
&imp_sth->fetch_position, 0, OCI_ATTR_CURRENT_POSITION, status);
+
+ if (DBIS->debug >= 4)
+ PerlIO_printf(DBILOGFP," Scrolling Fetch,
postion after fetch=%d\n",imp_sth->fetch_position);
+
+ } else {
+ OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp,1,
(ub2)OCI_FETCH_NEXT, 0, status);
- OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp,1,
(ub2)OCI_FETCH_NEXT, OCI_DEFAULT, status);
+ }
}
@@ -2969,10 +3039,9 @@
return oci_error(sth, errhp, status, "OCIAttrGet OCI_ATTR_ROWID
/LOB refetch");
-
- OCIStmtExecute_log_stat(imp_sth->svchp, lr->stmthp, errhp,
+ OCIStmtExecute_log_stat(imp_sth->svchp, lr->stmthp, errhp,
1, 0, NULL, NULL, OCI_DEFAULT, status); /* execute and fetch */
- if (status != OCI_SUCCESS)
+ if (status != OCI_SUCCESS)
return oci_error(sth, errhp, status,
ora_sql_error(imp_sth,"OCIStmtExecute/LOB refetch"));
Modified: dbd-oracle/trunk/ocitrace.h
==============================================================================
--- dbd-oracle/trunk/ocitrace.h (original)
+++ dbd-oracle/trunk/ocitrace.h Wed Mar 19 08:27:23 2008
@@ -440,18 +440,18 @@
ul_t((ro)),(void*)(si),(void*)(so),ul_t((md)), \
oci_status_name(stat)),stat : stat
#if !defined(USE_ORA_OCI_STMNT_FETCH)
- #define OCIStmtFetch_log_stat(sh,eh,nr,or,md,stat) \
- stat=OCIStmtFetch2(sh,eh,nr,or,0,md); \
+ #define OCIStmtFetch_log_stat(sh,eh,nr,or,os,stat) \
+ stat=OCIStmtFetch2(sh,eh,nr,or,os,OCI_DEFAULT);
\
(DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP,
\
"%sStmtFetch(%p,%p,%lu,%u,%lu)=%s\n",
\
- OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or,ul_t(md),
\
+ OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or,(ub2)os,
\
oci_status_name(stat)),stat : stat
#else
-#define OCIStmtFetch_log_stat(sh,eh,nr,or,md,stat) \
- stat=OCIStmtFetch(sh,eh,nr,or,md); \
+#define OCIStmtFetch_log_stat(sh,eh,nr,or,os,stat) \
+ stat=OCIStmtFetch(sh,eh,nr,or,OCI_DEFAULT);
\
(DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP,
\
- "%sStmtFetch(%p,%p,%lu,%u,%lu)=%s\n",
\
- OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or,ul_t(md),
\
+ "%sStmtFetch(%p,%p,%lu,%lu)=%s\n", \
+ OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or, \
oci_status_name(stat)),stat : stat
#endif
Added: dbd-oracle/trunk/t/51scroll.t
==============================================================================
--- (empty file)
+++ dbd-oracle/trunk/t/51scroll.t Wed Mar 19 08:27:23 2008
@@ -0,0 +1,121 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More tests => 33;
+use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes);
+use DBI;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+## ----------------------------------------------------------------------------
+## 51scroll.t
+## By John Scoles, The Pythian Group
+## ----------------------------------------------------------------------------
+## Just a few checks to see if one can use a scrolling cursor
+## Nothing fancy.
+## ----------------------------------------------------------------------------
+
+BEGIN {
+ use_ok('DBI');
+}
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1,
+ AutoCommit=>1,
+ PrintError => 0 });
+ok ($dbh->{RowCacheSize} = 10);
+
+# check that our db handle is good
+isa_ok($dbh, "DBI::db");
+
+my $table = table();
+
+
+$dbh->do(qq{
+ CREATE TABLE $table (
+ id INTEGER )
+ });
+
+
+my ($sql, $sth,$value);
+my $i=0;
+$sql = "INSERT INTO ".$table." VALUES (?)";
+
+$sth =$dbh-> prepare($sql);
+
+for ($i=1;$i<=10;$i++){
+ $sth-> bind_param(1, $i);
+ $sth->execute();
+}
+
+$sql="select * from ".$table;
+ok($sth=$dbh->prepare($sql,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>200}));
+ok ($sth->execute());
+
+#first loop all the way forward with OCI_FETCH_NEXT
+for($i=1;$i<=10;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0);
+ cmp_ok($value->[0], '==', $i, '... we should get the next record');
+}
+
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0);
+cmp_ok($value->[0], '==', 10, '... we should get the 10th record');
+
+#now loop all the way back
+for($i=1;$i<=9;$i++){
+ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0);
+ cmp_ok($value->[0], '==', 10-$i, '... we should get the prior record');
+}
+
+#now +4 records relative from the present position of 0;
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,4);
+cmp_ok($value->[0], '==', 5, '... we should get the 5th record');
+
+#now +2 records relative from the present position of 4;
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,2);
+cmp_ok($value->[0], '==', 7, '... we should get the 7th record');
+
+#now -3 records relative from the present position of 6;
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-3);
+
+cmp_ok($value->[0], '==', 4, '... we should get the 4th record');
+
+#now get the 9th record from the start
+$value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,9);
+
+cmp_ok($value->[0], '==', 9, '... we should get the 9th record');
+
+#now get the last record
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0);
+
+cmp_ok($value->[0], '==', 10, '... we should get the 10th record');
+
+#now get the ora_scroll_position
+
+cmp_ok($sth->ora_scroll_position(), '==', 10, '... we should get the 10 for
the ora_scroll_position');
+
+#now back to the first
+
+$value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0);
+cmp_ok($value->[0], '==', 1, '... we should get the 1st record');
+
+#check the ora_scroll_position one more time
+
+cmp_ok($sth->ora_scroll_position(), '==', 1, '... we should get the 1 for the
ora_scroll_position');
+
+$sth->finish();
+drop_table($dbh);
+
+
+$dbh->disconnect;
+
+1;
+
