[svn:dbd-oracle] r14618 - in dbd-oracle/branches/mjevans: . t

[email protected] Thu, 30 Dec 2010 05:13:08 -0800 (PST)
Newsgroups perl.dbd.oracle.changes
Message-ID <[email protected]>
Author: mjevans
Date: Thu Dec 30 05:13:06 2010
New Revision: 14618

Added:
   dbd-oracle/branches/mjevans/t/rt64206.pl   (contents, props changed)
Modified:
   dbd-oracle/branches/mjevans/Changes
   dbd-oracle/branches/mjevans/oci8.c

Log:
partial fix for rt64206


Modified: dbd-oracle/branches/mjevans/Changes
==============================================================================
--- dbd-oracle/branches/mjevans/Changes	(original)
+++ dbd-oracle/branches/mjevans/Changes	Thu Dec 30 05:13:06 2010
@@ -1,6 +1,10 @@
+=head1 Changes in DBD-Oracle 1.28 (svn rev NNNNN)
+
+  Fix support for quoted table names when binding lobs by Martin J. Evans
+
 =head1 Changes in DBD-Oracle 1.27 (svn rev 14583)
 
-  This version removes ‘PERL_POLLUTE’ and adds in PL_ where required so it will be fully compatible with Perl 5.13
+  This version removes "PERL_POLLUTE" and adds in PL_ where required so it will be fully compatible with Perl 5.13
 
 =head1 Changes in DBD-Oracle 1.26 (svn rev 14411)
 

Modified: dbd-oracle/branches/mjevans/oci8.c
==============================================================================
--- dbd-oracle/branches/mjevans/oci8.c	(original)
+++ dbd-oracle/branches/mjevans/oci8.c	Thu Dec 30 05:13:06 2010
@@ -3955,6 +3955,18 @@
 }
 
 
+/*
+ * Given some SQL in src and a string in the SQL to start looking (after)
+ * find the next identifier returning a ptr to it and setting its length in
+ * *len. If copy is set the returned string will be a copy of the identifier
+ * we found.
+ *
+ * e.g., table = find_ident_after("insert into mytable values (?)",
+ *                                "into", &table_len, 1)
+ *
+ * NOTE: if the identifier is in quotes they need to be maintained
+ *       see rt 64206
+ */
 char *
 find_ident_after(char *src, char *after, STRLEN *len, int copy)
 {
@@ -3973,7 +3985,7 @@
 		else if (*src == '/' && src[1] == '*') {
 			while(*src && !(*src == '*' && src[1]=='/')) ++src;
 		}
-		else if (isALPHA(*src)) {
+		else if (isALPHA(*src) || (*src == '"')) {
 			if (seen_key) {
 				char *start = src;
 				while(*src && (isALNUM(*src) || *src=='.' || *src=='$' || *src=='"'))
@@ -4214,7 +4226,7 @@
 			if (phs->ora_field) {	/* must match this phs by field name	*/
 				char *ora_field_name = SvPV(phs->ora_field,PL_na);
 				if (SvCUR(phs->ora_field) != SvCUR(sv)
-					|| ibcmp(ora_field_name, SvPV(sv,PL_na), (I32)SvCUR(sv) ) )
+					|| ibcmp(ora_field_name, SvPV_nolen(sv), (I32)SvCUR(sv) ) )
 					continue;
 			}
 			else {			/* basic dumb match by type		*/

Added: dbd-oracle/branches/mjevans/t/rt64206.pl
==============================================================================
--- (empty file)
+++ dbd-oracle/branches/mjevans/t/rt64206.pl	Thu Dec 30 05:13:06 2010
@@ -0,0 +1,101 @@
+#!perl -w
+# $Id$
+# Tests reproducing rt64206. When you name your table with quotes to stop
+# Oracle uppercasing the table name and attempt to insert a lob using
+# ora_type => ora_clob (or blob) you will get error:
+#
+# DBD::Oracle::st execute failed: ORA-01741: illegal zero-length identifier
+# ORA-01741: illegal zero-length identifier
+# (DBD SUCCESS: OCIDescribeAny(view)/LOB refetch)
+# [for Statement "insert into "bindtype_test" (ablob) values(?)" with
+# ParamValues: :p1='abc'] at t/rt64206.pl line 36.
+#
+# The problem was that oci8.c/find_ident_after returns the table name
+# with the trailing quote but without the leading "
+#
+use strict;
+use warnings;
+use DBI;
+use Test::More;
+
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI->connect($dsn, $dbuser, '', {RaiseError => 1});
+
+if ($dbh) {
+    plan tests => 3;
+} else {
+    plan skip_all => "Unable to connect to Oracle ($DBI::errstr)\nTests skipped.\n";
+}
+
+my $table = q/"dbd_oracle_drop_me"/;
+$dbh->do(qq/CREATE TABLE $table ("id" integer NULL, alob clob NULL)/);
+my ($sth, $worked);
+
+{
+    local $dbh->{PrintError} = 0;
+    $sth = $dbh->prepare(qq/insert into $table (alob) values(?)/);
+    $sth->bind_param(1, 'abc', {ora_type => DBD::Oracle::ORA_CLOB()});
+    eval {$sth->execute};
+    diag($@);
+    $worked = ok(!$@, "insert clob into quoted table");
+}
+
+SKIP: {
+    skip "first test failed so no point in second test", 1 if !$worked;
+
+    # Generated
+    # DBD::Oracle::st execute failed: ORA-00904: "ALOB": invalid identifier
+    # (DBD ERROR : error possibly near <*> indicator at char 12 in
+    # 'insert into <*>"dbd_oracle_dr
+    $dbh->do(qq/drop table $table/);
+    $dbh->do(qq/create table $table ("id" integer NULL, "alob" clob NULL)/);
+
+    {
+        # DBD::Oracle::st execute failed: ORA-00904: "ALOB": invalid
+        # identifier (DBD ERROR : error possibly near <*> indicator at char
+        # 12 in 'insert into <*>"dbd_oracle_drop_me" ("alob") values(:p1)')
+        # [for Statement "insert into "dbd_oracle_drop_me" ("alob")
+        # values(?)" with ParamValues: :p1='abc'] at t/rt64206.pl line 58.
+        local $dbh->{PrintError} = 0;
+        $sth = $dbh->prepare(qq/insert into $table ("alob") values(?)/);
+        $sth->bind_param(1, 'abc', {ora_type => DBD::Oracle::ORA_CLOB()});
+        eval {$sth->execute};
+        diag($@);
+        ok(!$@, "insert clob into quoted column");
+    }
+
+    {
+        local $dbh->{PrintError} = 0;
+        $sth = $dbh->prepare(qq/insert into $table ("alob") values(?)/);
+        # Currently, the following will not work as DBD::Oracle compares
+        # the column name (unquoted) with the ora_field for length.
+        $sth->bind_param(1, 'abc',
+                         {ora_type => DBD::Oracle::ORA_CLOB(),
+                          ora_field => '"alob"'});
+        eval {$sth->execute};
+        diag($@);
+        ok(!$@, "insert clob into quoted column with ora_field");
+    }
+};
+
+END {
+    if ($dbh) {
+        local $dbh->{PrintError} = 0;
+        local $dbh->{RaiseError} = 1;
+        eval {$dbh->do(qq/DROP TABLE $table/);};
+        if ($@) {
+            warn("table $table possibly not dropped - check $@\n");
+        } else {
+            diag("table $table dropped\n");
+        }
+    }
+};
+
+
+