gistfile1.perl

Index: lib/DBD/Oracle.pm
===================================================================
--- lib/DBD/Oracle.pm	(revision 15190)
+++ lib/DBD/Oracle.pm	(working copy)
@@ -753,7 +753,38 @@
 	    }
 	}
 	$SQL .= " ORDER BY TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION\n";
-	my $sth = $dbh->prepare( $SQL ) or return undef;
+        
+
+        # Since DATA_DEFAULT is a LONG, DEFAULT values longer than 80 chars will
+        # throw an ORA-24345 by default; so we check if LongReadLen is set at
+        # the default value, and if so, set it to something less likely to fail
+        # in common usage.
+        #
+        # We do not set LongTruncOk however as that would make COLUMN_DEF
+        # incorrect, in those (extreme!) cases it would be better if the user
+        # sets LongReadLen herself.
+
+        my $long_read_len = $dbh->FETCH('LongReadLen');
+
+        my ($sth, $exc);
+
+        {
+            local $@;
+            eval {
+                $dbh->STORE(LongReadLen => 1024*1024) if $long_read_len == 80;
+                $sth = $dbh->prepare( $SQL );
+            };
+            $exc = $@;
+        }
+        if ($exc) {
+            $dbh->STORE(LongReadLen => 80) if $long_read_len == 80;
+            die $exc;
+        }
+
+        $dbh->STORE(LongReadLen => 80) if $long_read_len == 80;
+
+        return undef if not $sth;
+
 	$sth->execute( @BindVals ) or return undef;
 	$sth;
     }
Index: t/70meta.t
===================================================================
--- t/70meta.t	(revision 15190)
+++ t/70meta.t	(working copy)
@@ -12,10 +12,10 @@
 
 my $dsn = oracle_test_dsn();
 my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
-my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 });
+my $dbh = DBI->connect($dsn, $dbuser, '', { RaiseError => 1, PrintError => 0 });
 
 if ($dbh) {
-    plan tests=>13;
+    plan tests=>21;
 } else {
     plan skip_all => "Unable to connect to Oracle";
 }
@@ -53,6 +53,34 @@
 note "sql_dbms_version=$sql_dbms_version";
 like($sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'matched');
 
+# test long DEFAULT from column_info
+SKIP: {
+    my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||'');
+
+    eval { $dbh->do("DROP TABLE $table") };
+
+    my $created = eval { $dbh->do("CREATE TABLE $table (testcol NUMBER(15) DEFAULT to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10))))") };
+
+    skip 'could not create test table', 8 unless $created;
+
+    is $dbh->{LongReadLen}, 80, 'LongReadLen is at default';
+
+    ok((my $sth = $dbh->column_info(undef, '%', uc($table), '%')), 'column_info sth');
+
+    is $dbh->{LongReadLen}, 80, 'LongReadLen still at default';
+
+    ok((my $info = eval { $sth->fetchrow_hashref }), 'sth->fetchrow_hashref lived')
+        or diag $@;
+
+    is $info->{COLUMN_DEF}, "to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10)))", 'long DEFAULT matched';
+
+    ok($sth->finish, 'sth->finish');
+
+    is $dbh->{LongReadLen}, 80, 'LongReadLen still at default';
+
+    ok($dbh->do("DROP TABLE $table"), 'drop table');
+}
+
 $dbh->disconnect;
 
 exit 0;