Author: byterock
Date: Mon Mar 17 12:05:37 2008
New Revision: 10930
Modified:
dbd-oracle/branches/scroll/Oracle.h
dbd-oracle/branches/scroll/Oracle.pm
dbd-oracle/branches/scroll/Oracle.xs
dbd-oracle/branches/scroll/dbdimp.c
dbd-oracle/branches/scroll/dbdimp.h
dbd-oracle/branches/scroll/oci8.c
Log:
Reworked the patch so it does not need the DBI patch and it seems to be working
ok. Still to-do is test for this and getting the OCI_ATTR_CURRENT_POSITION out
and back into perl.
Modified: dbd-oracle/branches/scroll/Oracle.h
==============================================================================
--- dbd-oracle/branches/scroll/Oracle.h (original)
+++ dbd-oracle/branches/scroll/Oracle.h Mon Mar 17 12:05:37 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/branches/scroll/Oracle.pm
==============================================================================
--- dbd-oracle/branches/scroll/Oracle.pm (original)
+++ dbd-oracle/branches/scroll/Oracle.pm Mon Mar 17 12:05:37 2008
@@ -22,11 +22,14 @@
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 OCI_STMT_SCROLLABLE_READONLY OCI_FETCH_NEXT
+ OCI_FETCH_CURRENT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR
+ OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE ORA_OCI
) ],
ora_session_modes => [ qw( ORA_SYSDBA ORA_SYSOPER ) ],
);
- @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));
@@ -68,7 +71,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_row_count");
+
$drh;
}
@@ -855,13 +860,13 @@
{ package DBD::Oracle::st; # ====== STATEMENT ======
- sub fetch_scroll {
- my $sth = shift;
- my ($attr) = @_;
-
- my $row = ora_fetch_scroll($sth,$attr);
- return @$row;;
- }
+ #sub fetch_scroll {
+ # my $sth = shift;
+ # my ($attr) = @_;
+
+ # my $row = ora_fetch_scroll($sth,$attr);
+ # return @$row;;
+ #}
sub bind_param_inout_array {
my $sth = shift;
@@ -1199,7 +1204,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
@@ -1488,7 +1493,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.
@@ -3227,7 +3232,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/branches/scroll/Oracle.xs
==============================================================================
--- dbd-oracle/branches/scroll/Oracle.xs (original)
+++ dbd-oracle/branches/scroll/Oracle.xs Mon Mar 17 12:05:37 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));
@@ -79,13 +97,32 @@
void
+ora_scroll_row_count(sth)
+ SV * sth
+ PREINIT:
+ D_imp_sth(sth);
+ sword status;
+ CODE:
+ {
+ ub4 row_count = 0;
+ int cp;
+ ub4 sz = sizeof(cp) ;
+ OCIAttrGet_stmhp_stat(imp_sth, &cp, &sz, OCI_ATTR_CURRENT_POSITION,
status);
+ PerlIO_printf(DBILOGFP, " cp=%d,status=%d\n",row_count,status);
+ row_count=OCIAttrGet_stmhp_stat(imp_sth, &row_count, &sz,
OCI_ATTR_ROW_COUNT, status);
+
+ PerlIO_printf(DBILOGFP, " row_count=%d,status=%d\n",row_count,status);
+ XST_mIV(0, row_count);
+}
+
+void
ora_fetch_scroll(sth,attribs)
SV * sth
SV * attribs
PREINIT:
+ D_imp_sth(sth);
CODE:
{
- D_imp_sth(sth);
AV *av;
SV **svp;
int fetch_orient = OCI_FETCH_NEXT;
@@ -94,7 +131,6 @@
DBD_ATTRIB_GET_IV( attribs, "fetch_offset",12, svp, fetch_offset);
imp_sth->fetch_orient=fetch_orient;
imp_sth->fetch_offset=fetch_offset;
- PerlIO_printf(DBILOGFP, " ora_fetch_scroll attribs fetch_orient=%d and
fetch_offset=%d\n", fetch_orient,fetch_offset);
av = dbd_st_fetch(sth,imp_sth);
ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
}
Modified: dbd-oracle/branches/scroll/dbdimp.c
==============================================================================
--- dbd-oracle/branches/scroll/dbdimp.c (original)
+++ dbd-oracle/branches/scroll/dbdimp.c Mon Mar 17 12:05:37 2008
@@ -2859,19 +2859,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,
@@ -2933,14 +2934,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_STMT_SCROLLABLE_READONLY),
- 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"));
Modified: dbd-oracle/branches/scroll/dbdimp.h
==============================================================================
--- dbd-oracle/branches/scroll/dbdimp.h (original)
+++ dbd-oracle/branches/scroll/dbdimp.h Mon Mar 17 12:05:37 2008
@@ -98,7 +98,10 @@
int est_width; /* est'd avg row width on-the-wire */
/* (In/)Out Parameter Details */
bool has_inout_params;
- /* fetch scrooling values */
+ /* execute mode*/
+ /* will be using this alot later me thinks */
+ ub4 exe_mode;
+ /* fetch scrolling values */
int fetch_orient;
int fetch_offset;
};
Modified: dbd-oracle/branches/scroll/oci8.c
==============================================================================
--- dbd-oracle/branches/scroll/oci8.c (original)
+++ dbd-oracle/branches/scroll/oci8.c Mon Mar 17 12:05:37 2008
@@ -254,17 +254,18 @@
{
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 ora_exe_mode = OCI_DEFAULT; /* default is OCI_DEFAULT*/
+ 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 +275,36 @@
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);
- }
+
+ 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,
ora_exe_mode);
+ imp_sth->exe_mode = ora_exe_mode;
+
+ }
- /* 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 +313,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);
@@ -334,13 +341,13 @@
DBIc_IMPSET_on(imp_sth);
- /* if (ora_check_sql) {
+ if (ora_check_sql) {
if (!dbd_describe(sth, imp_sth))
return 0;
}
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 ;
@@ -359,7 +366,7 @@
return 0;
}
}
-*/
+
return 1;
}
@@ -2336,21 +2343,6 @@
return (num_errors>0) ? 0 : 1;
}
-/*AV *
-ora_fetch_scroll(SV *sth, imp_sth_t *imp_sth,SV *attribs){
- dTHX;
- D_imp_dbh_from_sth;
- AV *av;
- SV **svp;
- int 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);
- av = dbd_st_fetch(sth,imp_sth);
- PerlIO_printf(DBILOGFP, " ora_fetch_scroll attribs fetch_orient=%d and
fetch_offset=%d\n", fetch_orient,fetch_offset);
- return (-1) ? Nullav : av;
-}
-*/
AV *
dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){
@@ -2387,11 +2379,12 @@
PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields...\n",
DBIc_NUM_FIELDS(imp_sth));
}
if (imp_sth->fetch_orient) {
- PerlIO_printf(DBILOGFP, " dbd_st_fetch
imp_sth->fetch_orient = %d,imp_sth->fetch_offset=
%d...\n",imp_sth->fetch_orient,imp_sth->fetch_offset);
-
+ int cp;
+ ub4 sz = sizeof(cp) ;
OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp,1,
imp_sth->fetch_orient,imp_sth->fetch_offset, status);
- PerlIO_printf(DBILOGFP, "
OCI_FETCH_LAST=%d status = %d,..\n",OCI_FETCH_LAST,status);
-
+ OCIAttrGet_stmhp_stat(imp_sth, &cp, &sz,
OCI_ATTR_CURRENT_POSITION, status);
+ PerlIO_printf(DBILOGFP, " OCI_ATTR_CURRENT_POSITION= %d
...\n", cp);
+
} else {
OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp,1,
(ub2)OCI_FETCH_NEXT, 0, status);
