Author: byterock
Date: Wed May 21 11:05:53 2008
New Revision: 11298
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/Oracle.pm
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/t/40ph_type.t
Log:
Fix for rt.cpan.org Ticket #=28811 ORA_CHAR(s) not returning correct length in
functions and procedures from John Scoles
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Wed May 21 11:05:53 2008
@@ -1,4 +1,5 @@
=head1 Changes in DBD-Oracle 1.22(svn rev xxxx) 2008
+ Fix for rt.cpan.org Ticket #=28811 ORA_CHAR(s) not returning correct length
in functions and procedures from John Scoles
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 & Darren Kipp
Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Wed May 21 11:05:53 2008
@@ -1611,7 +1611,7 @@
As the default placeholder type value in DBD::Oracle is ORA_VARCHAR2 to access
this behaviour you will
have to change the default placeholder type with L</ora_ph_type> or
placeholder
type for a particular call with L<DBI/bind> or L<DBI/bind_param_inout>
-with L</ORA_CHAR> or C<ORA_CHARZ>.
+with L</ORA_CHAR>.
=head1 Metadata
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Wed May 21 11:05:53 2008
@@ -2185,22 +2185,22 @@
if (imp_sth->ora_pad_empty)
croak("Can't use ora_pad_empty with bind_param_inout");
if (SvTYPE(phs->sv)!=SVt_RV || !at_exec) {
- STRLEN min_len = (phs->ftype != 96) ? 28 : 0;
-
-
- /* if (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) {*/
-
- /* if not an array ref then do this */
- /* ensure room for result, 28 is magic number (see sv_2pv)
*/
- /* don't apply 28 char min to CHAR types - probably shouldn't
*/
- /* apply it anywhere really, trying to be too helpful.
*/
-
- /* phs->sv _is_ the real live variable, it may 'mutate' later
*/
- /* pre-upgrade to high'ish type to reduce risk of SvPVX
realloc/move */
- (void)SvUPGRADE(phs->sv, SVt_PVNV);
- SvGROW(phs->sv, (STRLEN)(((unsigned int) phs->maxlen < min_len) ?
min_len : (unsigned int) phs->maxlen)+1/*for null*/);
- /* }*/
- }
+
+ if (phs->ftype == 96){
+ SvGROW(phs->sv,(STRLEN) (unsigned
int)phs->maxlen-1);
+ } else {
+ STRLEN min_len = 28;
+ (void)SvUPGRADE(phs->sv, SVt_PVNV);
+ /* ensure room for result, 28 is magic number (see
sv_2pv) */
+ /* don't apply 28 char min to CHAR types - probably
shouldn't */
+ /* apply it anywhere really, trying to be too
helpful. */
+ /* phs->sv _is_ the real live variable, it may 'mutate'
later */
+ /* pre-upgrade to high'ish type to reduce risk of
SvPVX realloc/move */
+ SvGROW(phs->sv, (STRLEN)(((unsigned int)
phs->maxlen <= min_len) ? min_len : (unsigned int) phs->maxlen)+1/*for null*/);
+
+ }
+ }
+
}
/* At this point phs->sv must be at least a PV with a valid buffer,
*/
@@ -2223,11 +2223,8 @@
}
phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
-
-
- phs->maxlen = ((IV)SvLEN(phs->sv))-1; /* avail buffer space (64bit safe)
*/
-
-
+ phs->maxlen = ((IV)SvLEN(phs->sv)); /* avail buffer space (64bit safe)
Logicaly maxlen should never change but it does why I know not*/
+
if (phs->maxlen < 0) /* can happen with nulls */
phs->maxlen = 0;
@@ -3237,7 +3234,7 @@
}
if(len > (unsigned int) phs[i]->maxlen)
phs[i]->maxlen = len;
-
+
/* Do OCI bind calls on last iteration. */
if( ((unsigned int) j ) == exe_count - 1 ) {
if(!do_bind_array_exec(sth, imp_sth, phs[i])) {
Modified: dbd-oracle/trunk/t/40ph_type.t
==============================================================================
--- dbd-oracle/trunk/t/40ph_type.t (original)
+++ dbd-oracle/trunk/t/40ph_type.t Wed May 21 11:05:53 2008
@@ -118,7 +118,7 @@
$expect =~ s/\s+$// if $test_info->{chops_space};
my $ok = ($tmp->{ts}->{vc} eq $expect);
if (!$ok && $ph_type==1 && $name eq 'VARCHAR2') {
- warn " Placeholder behaviour for ora_type=1 (the default) varies with
Oracle version.\n";
+ warn " Placeholder behaviour for ora_type=1 VARCHAR2 (the default) varies
with Oracle version.\n";
warn " Oracle 7 didn't strip trailing spaces, Oracle 8 did, until 9.2.x\n";
warn " Your system doesn't. If that seems odd, let us know.\n";
$ok = 1;
