Tim Bunce <[EMAIL PROTECTED]> writes:
> On Fri, Jun 06, 2003 at 08:29:12AM +0200, Kristian Nielsen wrote:
> > We could use proper execute_array() support in DBD::Oracle, and having
> > already fiddled a bit with the code I am considering having a go at
> > implementing it (no promises though).
Well, I managed to get something working, and I thought I would post
what I have so far to perhaps get some feedback and spur the discussion
by providing something concrete.
> Seeing your message has prompted me to add something I'd been meaning
> to do for a while that will simplify this somewhat:
>
> =item C<execute_for_fetch>
>
> $rv = $sth->execute_for_fetch($fetch_tuple_sub);
> $rv = $sth->execute_for_fetch($fetch_tuple_sub, [EMAIL PROTECTED]);
>
> The execute_for_fetch() method is used to perform bulk operations
> and is most often used via the execute_array() method, not directly.
This is where I started. But as we discussed, OCI needs the tuple count
(and also the maximum bind lengths) up-front, so execute_for_fetch needs
to buffer tuples in batches. I then started to implement ora_execute_array
to take an array of tuples. But then I realised that this does not
support named placeholders (:foo style) well, and so I ended up with a
hybrid ora_execute_array that accepts both row-wise and column-wise
data. This isn't so bad, but the code is perhaps a bit convoluted as a
result. But it's a start.
The batch given below implements native DBD::Oracle bind_param_array()
and execute_array() with (I believe) full functionality. I also added an
'ArrayTuple' attribute to execute_array() that allows to pass an array
of tuples directly instead of a fetch_tuple sub or individual column
arrays (essentially exposing ora_execute_array() functionality).
Some other points:
To report errors for individual tuple executions, I use the
OCI_BATCH_ERRORS mode. As far as I have found, this mode is only fully
supported from Oracle 8.1.5 (not sure if that means client or server or
both). I'm not willing to do an alternative implementation for older
Oracle, but if there is a simple way to detect Oracle version in
Oracle.pm, I could fall-back to the DBI default implementation. BTW,
this is all OCI8 only, but I gather that OCI7 support is going away?
There is no support for in_out binding, though I would think that it
could be added later. No SELECT's either. There is also no support for
LOBs, and I am not sure that makes sense anyway.
I could not find any way to get the row counts for individual tuple
executions. So the status array returned by execute_array() will have
all elements as -1, (except for errors which are [errcode, errmsg]).
The total rowcount is returned, though.
Once the overall implementation and interface into DBI has been settled
a bit more I will of course add test cases and documentation as needed.
- Kristian.
[Patch from 'cvs rdiff -u' appended.]
--
Kristian Nielsen [EMAIL PROTECTED]
Development Manager, Sifira A/S
-----------------------------------------------------------------------
Index: source/perlmod/DBD-Oracle/Oracle.pm
diff -u source/perlmod/DBD-Oracle/Oracle.pm:1.2
source/perlmod/DBD-Oracle/Oracle.pm:1.2.2.4
--- source/perlmod/DBD-Oracle/Oracle.pm:1.2 Wed May 14 12:53:04 2003
+++ source/perlmod/DBD-Oracle/Oracle.pm Thu Jun 26 15:24:23 2003
@@ -825,7 +825,142 @@
{ package DBD::Oracle::st; # ====== STATEMENT ======
- # all done in XS
+ sub bind_param_array {
+ my ($sth, $ph, $vals, $attr) = @_;
+
+ return $sth->DBI::set_err(1, "Value for parameter $p_id must be a ".
+ "scalar or an arrayref, not a ".
+ ref($vals_array))
+ if defined $vals and ref $vals and ref $vals ne 'ARRAY';
+
+ # get/create arrayref to hold params
+ my $hash_of_arrays = $sth->{ParamArrays} ||= { };
+
+ # Promote scalar to singleton arrayref (later promoted to full-length
+ # arrayref if needed).
+ $vals = [ $vals ] unless ref($vals) eq 'ARRAY';
+
+ # Check that input has same length as existing binds.
+ # Promote singletons to full length.
+ foreach (keys %$hash_of_arrays) {
+ my $v = $hash_of_arrays->{$_};
+ if(@$vals != @$v) {
+ if(@$v == 1) {
+ $hash_of_arrays->{$_} = [ map $v->[0], ([EMAIL PROTECTED]) ];
+ } elsif(@$vals == 1) {
+ $vals = [ map $vals->[0], ([EMAIL PROTECTED]) ];
+ } else {
+ return $sth->DBI::set_err(1,
+ "Arrayref for parameter $ph has "[EMAIL PROTECTED]" elements"
+ ." but parameter $_ has "[EMAIL PROTECTED]);
+ }
+ }
+ }
+ $hash_of_arrays->{$ph} = $vals;
+ return $sth->bind_param($ph, undef, $attr)
+ if $attr;
+ 1;
+ }
+
+
+ sub execute_array {
+ my ($sth, $attr, @array_of_arrays) = @_;
+ my $NUM_OF_PARAMS = $sth->FETCH('NUM_OF_PARAMS'); # may be undef at this point
+
+ # First look for row-wise operation.
+ if(exists($attr->{ArrayTuple})) {
+ return $sth->DBI::set_err(1,
+ "Can't use both ArrayTuple and explicit bind values")
+ if @array_of_arrays;
+ my $tuple_array = $attr->{ArrayTuple};
+ return ora_execute_array($sth,
+ $tuple_array,
+ scalar(@$tuple_array),
+ $attr->{ArrayTupleStatus});
+ } elsif(exists($attr->{ArrayTupleFetch})) {
+ return $sth->DBI::set_err(1,
+ "Can't use both ArrayTupleFetch and explicit bind values")
+ if @array_of_arrays;
+
+ my $fetch_tuple = $attr->{ArrayTupleFetch};
+ if (UNIVERSAL::isa($fetch_tuple,'DBI::st')) {
+ my $fetch_sth = $fetch_tuple;
+ return $sth->DBI::set_err(1,
+ "ArrayTupleFetch sth is not Active, need to execute() it
first")
+ unless $fetch_sth->{Active};
+ # check column count match to give more friendly message
+ my $NUM_OF_FIELDS = $fetch_sth->{NUM_OF_FIELDS};
+ return $sth->DBI::set_err(1,
+ "$NUM_OF_FIELDS columns from ArrayTupleFetch sth but
$NUM_OF_PARAMS expected")
+ if defined($NUM_OF_FIELDS) && defined($NUM_OF_PARAMS)
+ && $NUM_OF_FIELDS != $NUM_OF_PARAMS;
+ $fetch_tuple = sub { $fetch_sth->fetchrow_arrayref };
+ }
+ elsif (!UNIVERSAL::isa($fetch_tuple,'CODE')) {
+ return $sth->DBI::set_err(1, "ArrayTupleFetch '$fetch_tuple' is not a
code ref or statement handle");
+ }
+
+ my $tuple_status = $attr->{ArrayTupleStatus};
+ my $row_count = 0;
+ my $tuple_batch_status = defined($tuple_status) ? [ ] : undef;
+ while (1) {
+ my @tuple_batch;
+ for (my $batch_size = 1000; $batch_size-- > 0; ) {
+ push @tuple_batch, [ @{$fetch_tuple->() || last} ];
+ }
+ last unless @tuple_batch;
+ my $res = ora_execute_array($sth,
+ [EMAIL PROTECTED],
+ scalar(@tuple_batch),
+ $tuple_batch_status);
+ if(defined($res) && defined($row_count)) {
+ $row_count += $res;
+ } else {
+ $row_count = undef;
+ }
+ push @$tuple_status, @$tuple_batch_status if $tuple_status;
+ }
+ return $row_count;
+ }
+
+ # If not row-wise, assume column-wise.
+ my @columns;
+ if(@array_of_arrays) {
+ @columns = map ":p$_", 1..scalar(@array_of_arrays);
+ } else {
+ # If no bind values supplied, look for some set by bind_param_array.
+ my $hash_of_arrays = $sth->{ParamArrays} || { };
+ @columns = ();
+ @array_of_arrays = ();
+ foreach (keys %$hash_of_arrays) {
+ push @columns, $_;
+ push @array_of_arrays, $hash_of_arrays->{$_};
+ }
+ }
+
+ return $sth->DBI::set_err(1,
+ @array_of_arrays." bind values supplied but $NUM_OF_PARAMS expected")
+ if defined ($NUM_OF_PARAMS) && @array_of_arrays != $NUM_OF_PARAMS;
+
+ my $exe_count;
+ if(@array_of_arrays == 0) {
+ # No placeholders? Execute a single iteration.
+ $exe_count = 1;
+ } else {
+ $exe_count = scalar(@{$array_of_arrays[0]});
+ for(my $i = 1; $i < @array_of_arrays; $i++) {
+ if(scalar(@{$array_of_arrays[$i]}) != $exe_count) {
+ return $sth->DBI::set_err
+ (1, "Inconsistent bind column lengths");
+ }
+ }
+ }
+ return ora_execute_array($sth,
+ [EMAIL PROTECTED],
+ $exe_count,
+ $attr->{ArrayTupleStatus},
+ [EMAIL PROTECTED]);
+ }
}
1;
Index: source/perlmod/DBD-Oracle/Oracle.xs
diff -u source/perlmod/DBD-Oracle/Oracle.xs:1.1.1.3
source/perlmod/DBD-Oracle/Oracle.xs:1.1.1.3.2.2
--- source/perlmod/DBD-Oracle/Oracle.xs:1.1.1.3 Wed May 14 12:38:15 2003
+++ source/perlmod/DBD-Oracle/Oracle.xs Thu Jun 26 10:04:02 2003
@@ -90,6 +90,32 @@
PerlIO_printf(DBILOGFP, " !! ERROR: %s %s",
neatsvpv(DBIc_ERR(imp_sth),0), neatsvpv(DBIc_ERRSTR(imp_sth),0));
+void
+ora_execute_array(sth, tuples, exe_count, tuples_status, cols=&sv_undef)
+ SV * sth
+ SV * tuples
+ int exe_count
+ SV * tuples_status
+ SV * cols
+ PREINIT:
+ D_imp_sth(sth);
+ int retval;
+ CODE:
+ /* XXX Need default bindings if any phs are so far unbound(?) */
+ /* XXX this code is duplicated in selectrow_arrayref above */
+ if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
+ DBIc_ROW_COUNT(imp_sth) = 0;
+ retval = ora_st_execute_array(sth, imp_sth, tuples, tuples_status,
+ cols, (ub4)exe_count);
+ /* XXX Handle return value ... like DBI::execute_array(). */
+ /* remember that dbd_st_execute must return <= -2 for error */
+ if (retval == 0) /* ok with no rows affected */
+ XST_mPV(0, "0E0"); /* (true but zero) */
+ else if (retval < -1) /* -1 == unknown number of rows */
+ XST_mUNDEF(0); /* <= -2 means error */
+ else
+ XST_mIV(0, retval); /* typically 1, rowcount or -1 */
+
void
cancel(sth)
Index: source/perlmod/DBD-Oracle/dbdimp.c
diff -u source/perlmod/DBD-Oracle/dbdimp.c:1.3
source/perlmod/DBD-Oracle/dbdimp.c:1.3.2.6
--- source/perlmod/DBD-Oracle/dbdimp.c:1.3 Wed May 14 12:53:04 2003
+++ source/perlmod/DBD-Oracle/dbdimp.c Thu Jun 26 20:05:03 2003
@@ -795,6 +795,7 @@
int idx=0;
char *style="", *laststyle=Nullch;
STRLEN namelen;
+ phs_t *phs;
/* allocate room for copy of statement with spare capacity */
/* for editing '?' or ':1' into ':p1' so we can use obndrv. */
@@ -895,8 +896,12 @@
if (imp_sth->all_params_hv == NULL)
imp_sth->all_params_hv = newHV();
phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1);
+ phs = (phs_t*)(void*)SvPVX(phs_sv);
hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0);
- strcpy( ((phs_t*)(void*)SvPVX(phs_sv))->name, start);
+#ifdef OCI_V8_SYNTAX
+ phs->idx = idx-1; /* Will be 0 for :1, -1 for :foo. */
+#endif
+ strcpy(phs->name, start);
}
*dest = '\0';
if (imp_sth->all_params_hv) {
@@ -1771,6 +1776,364 @@
return row_count; /* row count (0 will be returned as "0E0") */
}
+
+#ifdef OCI_V8_SYNTAX
+static int
+do_bind_array_exec(sth, imp_sth, phs)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ phs_t *phs;
+{
+ sword status;
+
+ OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name, (sb4)strlen(phs->name),
+ 0,
+ phs->maxlen ? (sb4)phs->maxlen : 1, /* else bind "" fails */
+ (ub2)phs->ftype, 0,
+ NULL, /* ub2 *alen_ptr not needed with OCIBindDynamic */
+ 0,
+ 0, /* max elements that can fit in allocated array */
+ NULL, /* (ptr to) current number of elements in array */
+ (ub4)OCI_DATA_AT_EXEC,
+ status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
+ return 0;
+ }
+ OCIBindDynamic_log(phs->bndhp, imp_sth->errhp,
+ (dvoid *)phs, dbd_phs_in,
+ (dvoid *)phs, dbd_phs_out, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic");
+ return 0;
+ }
+ return 1;
+}
+
+static void
+init_bind_for_array_exec(phs)
+ phs_t *phs;
+{
+ if (phs->sv == &sv_undef) { /* first bind for this placeholder */
+ phs->is_inout = 0;
+ phs->maxlen = 1;
+ /* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
+ if (phs->ftype==102)
+ phs->ftype = 116;
+ /* some types require the trailing null included in the length. */
+ /* SQLT_STR=5=STRING, SQLT_AVC=97=VARCHAR */
+ phs->alen_incnull = (phs->ftype==SQLT_STR || phs->ftype==SQLT_AVC);
+ }
+}
+
+/* Re-bind placeholders for array execute, to get the correct
+ max-length values. */
+static int
+ora_st_bind_for_array_exec(sth, imp_sth, tuples_av, exe_count, param_count,
columns_av)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ AV *tuples_av;
+ ub4 exe_count;
+ int param_count;
+ AV *columns_av;
+{
+ int i, j;
+ char namebuf[30];
+ SV **sv_p;
+ SV *sv;
+ AV *av;
+ phs_t **phs;
+ STRLEN len;
+ sword status;
+
+ phs = safemalloc(param_count*sizeof(*phs));
+ memset(phs, 0, param_count*sizeof(*phs));
+
+ /* Loop over values, computing maximum lengths. */
+ if(columns_av) {
+ /* Column-wise operation; tuples_av holds a list of columns. */
+ for(i = 0; i < param_count; i++) {
+ char *name;
+
+ sv_p = av_fetch(columns_av, i, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ croak("Missing column entry %d", i);
+ }
+ sv = *sv_p;
+ if (DBIS->debug >= 9)
+ PerlIO_printf(DBILOGFP, " arrbind %d->'%s'\n", i, neatsvpv(sv,0));
+ name = SvPV(sv, len);
+ sv_p = hv_fetch(imp_sth->all_params_hv, name, len, 0);
+ if (sv_p == NULL) {
+ Safefree(phs);
+ croak("Can't execute for non-existent placeholder %s",
+ neatsvpv(sv,0));
+ }
+ phs[i] = (phs_t*)(void*)SvPVX(*sv_p); /* placeholder struct */
+ phs[i]->idx = i;
+ init_bind_for_array_exec(phs[i]);
+
+ sv_p = av_fetch(tuples_av, i, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ croak("Cannot fetch column %d from tuple array", i);
+ }
+ sv = *sv_p;
+ if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) {
+ Safefree(phs);
+ croak("Not an array ref in column %d", i);
+ }
+ av = (AV*)SvRV(sv);
+
+ for(j = 0; j < exe_count; j++) {
+ sv_p = av_fetch(av, j, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ croak("Cannot fetch value for param %d in element %d", i, j);
+ }
+ sv = *sv_p;
+
+ /* Find the value length, and increase maxlen if needed. */
+ if(SvROK(sv)) {
+ Safefree(phs);
+ croak("Can't bind a reference (%s) for param %d, entry %d",
+ neatsvpv(sv,0), i, j);
+ }
+ SvPV(sv, len);
+ if(len > phs[i]->maxlen)
+ phs[i]->maxlen = len;
+ }
+
+ if(!do_bind_array_exec(sth, imp_sth, phs[i])) {
+ Safefree(phs);
+ return 0;
+ }
+ }
+ } else {
+ /* Row-wise operation; tuples_av holds a list of bind value tuples. */
+ for(j = 0; j < exe_count; j++) {
+ sv_p = av_fetch(tuples_av, j, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ croak("Cannot fetch tuple %d", j);
+ }
+ sv = *sv_p;
+ if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) {
+ Safefree(phs);
+ croak("Not an array ref in element %d", j);
+ }
+ av = (AV*)SvRV(sv);
+ for(i = 0; i < param_count; i++) {
+ if(!phs[i]) {
+ SV **phs_svp;
+
+ sprintf(namebuf, ":p%d", i+1);
+ phs_svp = hv_fetch(imp_sth->all_params_hv,
+ namebuf, strlen(namebuf), 0);
+ if (phs_svp == NULL) {
+ Safefree(phs);
+ croak("Can't execute for non-existent placeholder :%d", i);
+ }
+ phs[i] = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct
*/
+ if(phs[i]->idx < 0) {
+ Safefree(phs);
+ croak("Placeholder %d not of ?/:1 type", i);
+ }
+ init_bind_for_array_exec(phs[i]);
+ }
+
+ sv_p = av_fetch(av, phs[i]->idx, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ croak("Cannot fetch value for param %d in entry %d", i, j);
+ }
+ sv = *sv_p;
+
+ /* Find the value length, and increase maxlen if needed. */
+ if(SvROK(sv)) {
+ Safefree(phs);
+ croak("Can't bind a reference (%s) for param %d, entry %d",
+ neatsvpv(sv,0), i, j);
+ }
+ SvPV(sv, len);
+ if(len > phs[i]->maxlen)
+ phs[i]->maxlen = len;
+
+ /* Do OCI bind calls on last iteration. */
+ if(j == exe_count - 1) {
+ if(!do_bind_array_exec(sth, imp_sth, phs[i])) {
+ Safefree(phs);
+ return 0;
+ }
+ }
+ }
+ /* ToDo: Maybe extract common code from here and dbd_bind_ph() and put
+ it in some function(s) that can be called from both places. */
+ }
+ }
+
+ Safefree(phs);
+ return 1; /* Success. */
+}
+#endif /* OCI_V8_SYNTAX */
+
+int
+ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count)
+ SV *sth;
+ imp_sth_t *imp_sth;
+ SV *tuples;
+ SV *tuples_status;
+ SV *columns;
+ ub4 exe_count;
+{
+#ifdef OCI_V8_SYNTAX
+ dTHR;
+ ub4 row_count = 0;
+ int debug = DBIS->debug;
+ D_imp_dbh_from_sth;
+ sword status, exe_status;
+ int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
+ AV *tuples_av, *tuples_status_av, *columns_av;
+ ub4 oci_mode;
+ ub4 num_errs;
+ int i;
+ int autocommit = DBIc_has(imp_dbh,DBIcf_AutoCommit);
+
+ if (debug >= 2)
+ PerlIO_printf(DBILOGFP, " ora_st_execute_array %s count=%d (%s %s %s)...\n",
+ oci_stmt_type_name(imp_sth->stmt_type), exe_count,
+ neatsvpv(tuples,0), neatsvpv(tuples_status,0),
+ neatsvpv(columns, 0));
+
+ if (is_select) {
+ croak("ora_st_execute_array(): SELECT statement not supported "
+ "for array operation.");
+ }
+
+ if (imp_sth->out_params_av || imp_sth->has_lobs) {
+ croak("ora_st_execute_array(): Output placeholders and LOBs not "
+ "supported for array operation.");
+ }
+
+ /* Check that the `tuples' parameter is an array ref, find the length,
+ and store it in the statement handle for the OCI callback. */
+ if(!SvROK(tuples) || SvTYPE(SvRV(tuples)) != SVt_PVAV) {
+ croak("ora_st_execute_array(): Not an array reference.");
+ }
+ tuples_av = (AV*)SvRV(tuples);
+
+ /* Check the `columns' parameter. */
+ if(SvTRUE(columns)) {
+ if(!SvROK(columns) || SvTYPE(SvRV(columns)) != SVt_PVAV) {
+ croak("ora_st_execute_array(): columns not an array reference.");
+ }
+ columns_av = (AV*)SvRV(columns);
+ } else {
+ columns_av = NULL;
+ }
+
+ /* Check the `tuples_status' parameter. */
+ if(SvTRUE(tuples_status)) {
+ if(!SvROK(tuples_status) || SvTYPE(SvRV(tuples_status)) != SVt_PVAV) {
+ croak("ora_st_execute_array(): tuples_status not an array reference.");
+ }
+ tuples_status_av = (AV*)SvRV(tuples_status);
+ av_fill(tuples_status_av, exe_count - 1);
+ /* Fill in 'unknown' exe count in every element (know not how to get
+ individual execute row counts from OCI). */
+ for(i = 0; i < exe_count; i++) {
+ av_store(tuples_status_av, i, newSViv((IV)-1));
+ }
+ } else {
+ tuples_status_av = NULL;
+ }
+
+ /* Nothing to do if no tuples. */
+ if(exe_count <= 0)
+ return 0;
+
+ /* Ensure proper OCIBindByName() calls for all placeholders. */
+ if(!ora_st_bind_for_array_exec(sth, imp_sth, tuples_av, exe_count,
+ DBIc_NUM_PARAMS(imp_sth), columns_av))
+ return -2;
+
+ /* Store array of bind typles, for use in OCIBindDynamic() callback. */
+ imp_sth->bind_tuples = tuples_av;
+ imp_sth->rowwise = (columns_av == NULL);
+
+ oci_mode = OCI_BATCH_ERRORS;
+ if(autocommit)
+ oci_mode |= OCI_COMMIT_ON_SUCCESS;
+ OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
+ exe_count, 0, 0, 0, oci_mode, exe_status);
+ imp_sth->bind_tuples = NULL;
+
+ if (exe_status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, exe_status,
ora_sql_error(imp_sth,"OCIStmtExecute"));
+ if(exe_status != OCI_SUCCESS_WITH_INFO)
+ return -2;
+ }
+
+ OCIAttrGet_stmhp_stat(imp_sth, &num_errs, 0, OCI_ATTR_NUM_DML_ERRORS, status);
+ if (debug >= 6)
+ PerlIO_printf(DBILOGFP, " ora_st_execute_array %d errors in batch.\n",
+ num_errs);
+ if(num_errs && tuples_status_av) {
+ OCIError *row_errhp, *tmp_errhp;
+ ub4 row_off;
+ SV *err_svs[2];
+ AV *err_av;
+ sb4 err_code;
+
+ err_svs[0] = newSViv((IV)0);
+ err_svs[1] = newSVpvn("", 0);
+ OCIHandleAlloc_ok(imp_sth->envhp, &row_errhp, OCI_HTYPE_ERROR, status);
+ OCIHandleAlloc_ok(imp_sth->envhp, &tmp_errhp, OCI_HTYPE_ERROR, status);
+ for(i = 0; i < num_errs; i++) {
+ OCIParamGet_log_stat(imp_sth->errhp, OCI_HTYPE_ERROR,
+ tmp_errhp, (dvoid *)&row_errhp,
+ (ub4)i, status);
+ OCIAttrGet_log_stat(row_errhp, OCI_HTYPE_ERROR, &row_off, 0,
+ OCI_ATTR_DML_ROW_OFFSET, imp_sth->errhp, status);
+ if (debug >= 6)
+ PerlIO_printf(DBILOGFP, " ora_st_execute_array error in row %d.\n",
+ row_off);
+ sv_setpv(err_svs[1], "");
+ err_code = oci_error_get(row_errhp, exe_status, NULL, err_svs[1], debug);
+ sv_setiv(err_svs[0], (IV)err_code);
+ av_store(tuples_status_av, row_off,
+ newRV_noinc((SV *)(av_make(2, err_svs))));
+ }
+ OCIHandleFree_log_stat(tmp_errhp, OCI_HTYPE_ERROR, status);
+ OCIHandleFree_log_stat(row_errhp, OCI_HTYPE_ERROR, status);
+
+ /* Do a commit here if autocommit is set, since Oracle
+ doesn't do that for us when some rows are in error. */
+ if(autocommit) {
+ OCITransCommit_log_stat(imp_sth->svchp, imp_sth->errhp,
+ OCI_DEFAULT, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCITransCommit");
+ return -2;
+ }
+ }
+ }
+
+ if(num_errs) {
+ return -2;
+ } else {
+ ub4 row_count = 0;
+ OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
+ return row_count;
+ }
+
+#else /* !OCI_V8_SYNTAX */
+ croak ("ora_st_execute_array(): "
+ "Array execute not available with Oracle OCI7.");
+#endif /* OCI_V8_SYNTAX */
+}
Index: source/perlmod/DBD-Oracle/dbdimp.h
diff -u source/perlmod/DBD-Oracle/dbdimp.h:1.3
source/perlmod/DBD-Oracle/dbdimp.h:1.3.2.2
--- source/perlmod/DBD-Oracle/dbdimp.h:1.3 Wed May 14 12:53:04 2003
+++ source/perlmod/DBD-Oracle/dbdimp.h Thu Jun 26 10:04:02 2003
@@ -140,6 +140,9 @@
U16 auto_lob;
int has_lobs;
lob_refetch_t *lob_refetch;
+ AV *bind_tuples; /* Bind tuples in array execute, or NULL */
+ int rowwise; /* If true, bind_tuples is list of */
+ /* tuples, otherwise list of columns. */
#else
Cda_Def *cda; /* normally just points to cdabuf below */
Cda_Def cdabuf;
@@ -235,6 +238,7 @@
void *desc_h; /* descriptor if needed (LOBs etc) */
ub4 desc_t; /* OCI type of desc_h */
ub4 alen;
+ int idx; /* 0-based index for ?/:1 style, or -1 */
#else
ub2 alen; /* effective length ( <= maxlen ) */
#endif
@@ -292,6 +296,8 @@
dvoid **bufpp, ub4 **alenpp, ub1 *piecep,
dvoid **indpp, ub2 **rcodepp));
int dbd_rebind_ph_rset _((SV *sth, imp_sth_t *imp_sth, phs_t *phs));
+int ora_st_execute_array _((SV *sth, imp_sth_t *imp_sth, SV *tuples,
+ SV *tuples_status, SV *columns, ub4 exe_count));
void * oci_db_handle(imp_dbh_t *imp_dbh, int handle_type, int flags);
void * oci_st_handle(imp_sth_t *imp_sth, int handle_type, int flags);
Index: source/perlmod/DBD-Oracle/oci8.c
diff -u source/perlmod/DBD-Oracle/oci8.c:1.1.1.3
source/perlmod/DBD-Oracle/oci8.c:1.1.1.3.2.4
--- source/perlmod/DBD-Oracle/oci8.c:1.1.1.3 Wed May 14 12:38:15 2003
+++ source/perlmod/DBD-Oracle/oci8.c Thu Jun 26 10:04:02 2003
@@ -139,7 +139,7 @@
) {
if (debug >= 4 || recno>1/*XXX temp*/)
PerlIO_printf(DBILOGFP, " OCIErrorGet after %s (er%ld:%s): %d, %ld:
%s\n",
- what, (long)recno,
+ what ? what : "<NULL>", (long)recno,
(eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status),
status, (long)eg_errcode, errbuf);
errcode = eg_errcode;
@@ -360,6 +360,34 @@
{
phs_t *phs = octxp;
STRLEN phs_len;
+#ifdef OCI_V8_SYNTAX
+ AV *tuples_av;
+ SV *sv;
+ AV *av;
+ SV **sv_p;
+#endif
+
+#ifdef OCI_V8_SYNTAX
+ /* Check for bind values supplied by tuple array. */
+ tuples_av = phs->imp_sth->bind_tuples;
+ if(tuples_av) {
+ /* NOTE: we already checked the validity in ora_st_bind_for_array_exec(). */
+ sv_p = av_fetch(tuples_av, phs->imp_sth->rowwise ? iter : phs->idx, 0);
+ av = (AV*)SvRV(*sv_p);
+ sv_p = av_fetch(av, phs->imp_sth->rowwise ? phs->idx : iter, 0);
+ sv = *sv_p;
+ if(SvOK(sv)) {
+ *bufpp = SvPV(sv, phs_len);
+ phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;
+ phs->indp = 0;
+ } else {
+ *bufpp = SvPVX(sv);
+ phs->alen = 0;
+ phs->indp = -1;
+ }
+ }
+ else
+#endif
if (phs->desc_h) {
*bufpp = phs->desc_h;
phs->alen = 0;
@@ -383,7 +411,7 @@
PerlIO_printf(DBILOGFP, " in '%s' [%ld,%ld]: len %2ld, ind %d%s\n",
phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), phs->indp,
(phs->desc_h) ? " via descriptor" : "");
- if (index > 0 || iter > 0)
+ if (!tuples_av && (index > 0 || iter > 0))
croak("Arrays and multiple iterations not currently supported by DBD::Oracle
(in %d/%d)", index,iter);
return OCI_CONTINUE;
}
