Author: byterock
Date: Wed May 13 04:39:56 2009
New Revision: 12769
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/t/31lob.t
dbd-oracle/trunk/t/58object.t
Log:
Fix for rt.cpan.org Ticket #=46016 LOBs bound with ora_field broken from
RKITOVER also fix for warning in 58object.t
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Wed May 13 04:39:56 2009
@@ -1,3 +1,7 @@
+=head1 Changes in DBD-Oracle 1.24(svn rev???)
+ Fix for rt.cpan.org Ticket #=46016 LOBs bound with ora_field broken from
RKITOVER
+ Fix for bug in 58object.t when test run as externally identified user from
Charles Jardine
+
=head1 Changes in DBD-Oracle 1.23(svn rev 12724)
Fix from rt.cpan.org ticket #=44788 bool in_lite should be char in_literal
Fix for UTF8 and blobs by John Scoles with Milo van der Leij
Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Wed May 13 04:39:56 2009
@@ -3675,25 +3675,29 @@
"Need bind_param(..., {
ora_field=>... }) attribute to identify table LOB field names");
}
}
- matched = 1;
- sprintf(sql_field, "%s%s \"%s\"",
- (SvCUR(sql_select)>7)?", ":"", p,
&phs->name[1]);
- sv_catpv(sql_select, sql_field);
- if (DBIS->debug >= 3 || dbd_verbose >= 3 )
- PerlIO_printf(DBILOGFP,
- " lob refetch %s param:
otype %d, matched field '%s' %s(%s)\n",
- phs->name, phs->ftype, p,
- (phs->ora_field) ? "by name " : "by type ",
sql_field);
- (void)hv_delete(lob_cols_hv, p, i, G_DISCARD);
- fbh = &lr->fbh_ary[lr->num_fields++];
- fbh->name = phs->name;
- fbh->ftype = phs->ftype;
- fbh->dbtype = phs->ftype;
- fbh->disize = 99;
- fbh->desc_t = OCI_DTYPE_LOB;
- OCIDescriptorAlloc_ok(imp_sth->envhp,
&fbh->desc_h, fbh->desc_t);
- break; /* we're done with this placeholder now
*/
}
+
+ matched = 1;
+ sprintf(sql_field, "%s%s \"%s\"",
+ (SvCUR(sql_select)>7)?", ":"", p, &phs->name[1]);
+ sv_catpv(sql_select, sql_field);
+
+ if (DBIS->debug >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBILOGFP,
+ " lob refetch %s param: otype %d,
matched field '%s' %s(%s)\n",
+ phs->name, phs->ftype, p,
+ (phs->ora_field) ? "by name " : "by
type ", sql_field);
+ (void)hv_delete(lob_cols_hv, p, i,
G_DISCARD);
+ fbh = &lr->fbh_ary[lr->num_fields++];
+ fbh->name = phs->name;
+ fbh->ftype = phs->ftype;
+ fbh->dbtype = phs->ftype;
+ fbh->disize = 99;
+ fbh->desc_t = OCI_DTYPE_LOB;
+ OCIDescriptorAlloc_ok(imp_sth->envhp,
&fbh->desc_h, fbh->desc_t);
+
+ break; /* we're done with this placeholder now */
+
}
if (!matched) {
++unmatched_params;
Modified: dbd-oracle/trunk/t/31lob.t
==============================================================================
--- dbd-oracle/trunk/t/31lob.t (original)
+++ dbd-oracle/trunk/t/31lob.t Wed May 13 04:39:56 2009
@@ -1,7 +1,7 @@
#!/usr/bin/perl
use strict;
-use Test::More tests => 9;
+use Test::More tests => 11;
use DBD::Oracle qw(:ora_types);
use DBI;
@@ -38,6 +38,21 @@
($loc) = $sth->fetchrow;
is (ref $loc, "OCILobLocatorPtr", "returned valid locator");
+## test inserting a large value
+
+$stmt = "INSERT INTO $table (id,data) VALUES (666, ?)";
+$sth = $dbh->prepare($stmt);
+my $content = join(q{}, map { chr } ( 32 .. 64 )) x 16384;
+$sth->bind_param(1, $content, { ora_type => ORA_BLOB, ora_field => 'data' });
+eval { $sth->execute($content) };
+is $@, '', 'inserted into BLOB successfully';
+{
+ local $dbh->{LongReadLen} = 1_000_000;
+ my ($fetched) = $dbh->selectrow_array("select data from $table where id =
666");
+ is $fetched, $content, 'got back what we put in';
+}
+
+
## test with insert empty blob returning blob to a var.
($id, $loc) = (2, undef);
$stmt = "INSERT INTO $table (id,data) VALUES (?, EMPTY_BLOB()) RETURNING data
INTO ?";
Modified: dbd-oracle/trunk/t/58object.t
==============================================================================
--- dbd-oracle/trunk/t/58object.t (original)
+++ dbd-oracle/trunk/t/58object.t Wed May 13 04:39:56 2009
@@ -37,7 +37,7 @@
isa_ok($dbh, "DBI::db");
-ok(my $schema = $dbh->selectrow_array(
+ok( $schema = $dbh->selectrow_array(
"select sys_context('userenv', 'current_schema') from dual"
), 'Fetch current schema name');
