work around ORA-24345 from $dbh->column_info

jhannah reported getting ORA-24345: A Truncation or null fetch error
occurred (DBD ERROR: ORA-01406 error on field 13 of 18, ora_type 8,
 LongReadLen too small and/or LongTruncOk not set)

on running the loader on a table with a very long DEFAULT of
"to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ',
null,substrb(userenv('CLIENT_INFO'),1,10)))"

The fix is simply setting $dbh->{LongReadLen} in the _dbh_column_info
override for ::DBI::Oracle, but also make it work without the setting by
making the code involved much more robust.

Change Loader/DBI to fall back to the non-column_info code (that does a
 SELECT ... WHERE 1=0 and examines the $sth) when $dbh->column_info
fails in _columns_info_for, and wrap the fetchrow_hashref in a try {}
catch { +{} }; then skip columns where fetchrow_hashref fails and fill
them in from the WHERE 1=0 type_info code.

Also use this method instead of $dbh->column_info in Loader/DBI/Oracle
_table_columns by removing the overloaded method and using the
Loader/DBI implementation.

While there, clean up the _table_columns implementation in Loader/DBI to
use $self->_lc insetad of $sth->{NAME_lc} for consistency and
overridability.

Make the ::DBI::Oracle _columns_info_for pass all tests with both the
$dbh->column_info output and the type_info output from the parent ::DBI.

diff --git a/Changes b/Changes
index dc2831d..503df79 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - work around ORA-24345 from $dbh->column_info
         - fix spelling mistake in Base POD (RT#74796)
 
 0.07017  2012-02-07 07:23:48

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index 1e3f423..1ed2fee 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -256,10 +256,12 @@ sub _table_columns {
 
     my $sth = $self->_sth_for($table, undef, \'1 = 0');
     $sth->execute;
-    my $retval = $self->preserve_case ? \@{$sth->{NAME}} : \@{$sth->{NAME_lc}};
+
+    my $retval = [ map $self->_lc($_), @{$sth->{NAME}} ];
+
     $sth->finish;
 
-    $retval;
+    return $retval;
 }
 
 # Returns arrayref of pk col names
@@ -364,9 +366,10 @@ EOF
 
     # Failback: try the REMARKS column on column_info
     if (!$comment && $dbh->can('column_info')) {
-        my $sth = $self->_dbh_column_info( $dbh, undef, $table->schema, $table->name, $column_name );
-        my $info = $sth->fetchrow_hashref();
-        $comment = $info->{REMARKS};
+        if (my $sth = try { $self->_dbh_column_info( $dbh, undef, $table->schema, $table->name, $column_name ) }) {
+            my $info = $sth->fetchrow_hashref();
+            $comment = $info->{REMARKS};
+        }
     }
 
     return $comment;
@@ -443,9 +446,10 @@ sub _columns_info_for {
 
     my %result;
 
-    if ($dbh->can('column_info')) {
-        my $sth = $self->_dbh_column_info($dbh, undef, $table->schema, $table->name, '%' );
-        while ( my $info = $sth->fetchrow_hashref() ){
+    if (my $sth = try { $self->_dbh_column_info($dbh, undef, $table->schema, $table->name, '%' ) }) {
+        COL_INFO: while (my $info = try { $sth->fetchrow_hashref } catch { +{} }) {
+            next COL_INFO unless %$info;
+
             my $column_info = {};
             $column_info->{data_type}     = lc $info->{TYPE_NAME};
 
@@ -473,8 +477,6 @@ sub _columns_info_for {
             $result{$col_name} = $column_info;
         }
         $sth->finish;
-
-        return \%result if %result;
     }
 
     my $sth = $self->_sth_for($table, undef, \'1 = 0');
@@ -482,7 +484,9 @@ sub _columns_info_for {
 
     my @columns = @{ $sth->{NAME} };
 
-    for my $i (0 .. $#columns) {
+    COL: for my $i (0 .. $#columns) {
+        next COL if %{ $result{ $self->_lc($columns[$i]) }||{} };
+
         my $column_info = {};
         $column_info->{data_type} = lc $sth->{TYPE}[$i];
 

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
index 8b2a33c..44b8b00 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
@@ -7,6 +7,8 @@ use base qw/
     DBIx::Class::Schema::Loader::DBI
 /;
 use mro 'c3';
+use Try::Tiny;
+use namespace::clean;
 
 our $VERSION = '0.07017';
 
@@ -79,14 +81,6 @@ sub _filter_tables {
     return $self->next::method(@_);
 }
 
-sub _table_columns {
-    my ($self, $table) = @_;
-
-    my $sth = $self->dbh->column_info(undef, $table->schema, $table, '%');
-
-    return [ map $self->_lc($_->{COLUMN_NAME}), @{ $sth->fetchall_arrayref({ COLUMN_NAME => 1 }) || [] } ];
-}
-
 sub _table_uniq_info {
     my ($self, $table) = @_;
 
@@ -156,7 +150,7 @@ sub _columns_info_for {
 
     my $result = $self->next::method(@_);
 
-    local $self->dbh->{LongReadLen} = 100000;
+    local $self->dbh->{LongReadLen} = 1_000_000;
     local $self->dbh->{LongTruncOk} = 1;
 
     my $sth = $self->dbh->prepare_cached(<<'EOF', {}, 1);
@@ -186,18 +180,46 @@ EOF
     while (my ($col, $info) = each %$result) {
         no warnings 'uninitialized';
 
+        my $sth = $self->dbh->prepare_cached(<<'EOF', {}, 1);
+SELECT data_type, data_length
+FROM all_tab_columns
+WHERE column_name = ? AND table_name = ? AND owner = ?
+EOF
+        $sth->execute($self->_uc($col), $table->name, $table->schema);
+        my ($data_type, $data_length) = $sth->fetchrow_array;
+        $sth->finish;
+        $data_type = lc $data_type;
+
+        if ($data_type =~ /^(?:n(?:var)?char2?|u?rowid|nclob|timestamp\(\d+\)(?: with(?: local)? time zone)?|binary_(?:float|double))\z/i) {
+            $info->{data_type} = $data_type;
+
+            if ($data_type =~ /^u?rowid\z/i) {
+                $info->{size} = $data_length;
+            }
+        }
+
         if ($info->{data_type} =~ /^(?:n?[cb]lob|long(?: raw)?|bfile|date|binary_(?:float|double)|rowid)\z/i) {
             delete $info->{size};
         }
 
         if ($info->{data_type} =~ /^n(?:var)?char2?\z/i) {
-            $info->{size} = $info->{size} / 2;
+            if (ref $info->{size}) {
+                $info->{size} = $info->{size}[0] / 8;
+            }
+            else {
+                $info->{size} = $info->{size} / 2;
+            }
+        }
+        elsif ($info->{data_type} =~ /^(?:var)?char2?\z/i) {
+            if (ref $info->{size}) {
+                $info->{size} = $info->{size}[0];
+            }
         }
-        elsif (lc($info->{data_type}) eq 'number') {
+        elsif (lc($info->{data_type}) =~ /^(?:number|decimal)\z/i) {
             $info->{original}{data_type} = 'number';
             $info->{data_type}           = 'numeric';
 
-            if (eval { $info->{size}[0] == 38 && $info->{size}[1] == 0 }) {
+            if (try { $info->{size}[0] == 38 && $info->{size}[1] == 0 }) {
                 $info->{original}{size} = $info->{size};
 
                 $info->{data_type} = 'integer';
@@ -214,6 +236,11 @@ EOF
                 $info->{size} = $precision;
             }
         }
+        elsif ($info->{data_type} =~ /timestamp/i && ref $info->{size} && $info->{size}[0] == 0) {
+            my $size = $info->{size}[1];
+            delete $info->{size};
+            $info->{size} = $size unless $size == 6;
+        }
         elsif (($precision) = $info->{data_type} =~ /^interval year\((\d+)\) to month\z/i) {
             $info->{data_type} = join ' ', $info->{data_type} =~ /[a-z]+/ig;
 
@@ -234,6 +261,21 @@ EOF
                 $info->{size} = [ $day_precision, $second_precision ];
             }
         }
+        elsif ($info->{data_type} =~ /^interval year to month\z/i && ref $info->{size}) {
+            my $precision = $info->{size}[0];
+
+            if ($precision == 2) {
+                delete $info->{size};
+            }
+            else {
+                $info->{size} = $precision;
+            }
+        }
+        elsif ($info->{data_type} =~ /^interval day to second\z/i && ref $info->{size}) {
+            if ($info->{size}[0] == 2 && $info->{size}[1] == 6) {
+                delete $info->{size};
+            }
+        }
         elsif (lc($info->{data_type}) eq 'float') {
             $info->{original}{data_type} = 'float';
             $info->{original}{size}      = $info->{size};
@@ -246,9 +288,29 @@ EOF
             }
             delete $info->{size};
         }
+        elsif (lc($info->{data_type}) eq 'double precision') {
+            $info->{original}{data_type} = 'float';
+
+            my $size = try { $info->{size}[0] };
+
+            $info->{original}{size} = $size;
+
+            if ($size <= 63) {
+                $info->{data_type} = 'real';
+            }
+            delete $info->{size};
+        }
         elsif (lc($info->{data_type}) eq 'urowid' && $info->{size} == 4000) {
             delete $info->{size};
         }
+        elsif ($info->{data_type} eq '-9104') {
+            $info->{data_type} = 'rowid';
+            delete $info->{size};
+        }
+        elsif ($info->{data_type} eq '-2') {
+            $info->{data_type} = 'raw';
+            $info->{size} = try { $info->{size}[0] / 2 };
+        }
         elsif (lc($info->{data_type}) eq 'date') {
             $info->{data_type}           = 'datetime';
             $info->{original}{data_type} = 'date';
@@ -260,9 +322,43 @@ EOF
         elsif (lc($info->{data_type}) eq 'binary_double') {
             $info->{data_type}           = 'double precision';
             $info->{original}{data_type} = 'binary_double';
-        } 
+        }
+
+        # DEFAULT could be missed by ::DBI because of ORA-24345
+        if (not defined $info->{default_value}) {
+            local $self->dbh->{LongReadLen} = 1_000_000;
+            local $self->dbh->{LongTruncOk} = 1;
+            my $sth = $self->dbh->prepare_cached(<<'EOF', {}, 1);
+SELECT data_default
+FROM all_tab_columns
+WHERE column_name = ? AND table_name = ? AND owner = ?
+EOF
+            $sth->execute($self->_uc($col), $table->name, $table->schema);
+            my ($default) = $sth->fetchrow_array;
+            $sth->finish;
+
+            # this is mostly copied from ::DBI::QuotedDefault
+            if (defined $default) {
+                s/^\s+//, s/\s+\z// for $default;
+
+                if ($default =~ /^'(.*?)'\z/) {
+                    $info->{default_value} = $1;
+                }
+                elsif ($default =~ /^(-?\d.*?)\z/) {
+                    $info->{default_value} = $1;
+                }
+                elsif ($default =~ /^NULL\z/i) {
+                    my $null = 'null';
+                    $info->{default_value} = \$null;
+                }
+                elsif ($default ne '') {
+                    my $val = $default;
+                    $info->{default_value} = \$val;
+                }
+            }
+        }
 
-        if ((eval { lc(${ $info->{default_value} }) }||'') eq 'sysdate') {
+        if ((try { lc(${ $info->{default_value} }) }||'') eq 'sysdate') {
             my $current_timestamp  = 'current_timestamp';
             $info->{default_value} = \$current_timestamp;
 
@@ -274,6 +370,17 @@ EOF
     return $result;
 }
 
+sub _dbh_column_info {
+    my $self  = shift;
+    my ($dbh) = @_;
+
+    # try to avoid ORA-24345
+    local $dbh->{LongReadLen} = 1_000_000;
+    local $dbh->{LongTruncOk} = 1;
+
+    return $self->next::method(@_);
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,

diff --git a/t/10_05ora_common.t b/t/10_05ora_common.t
index d274b48..566a5de 100644 (file)
--- a/t/10_05ora_common.t
+++ b/t/10_05ora_common.t
@@ -81,6 +81,12 @@ my $tester = dbixcsl_common_tests->new(
         'int'          => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
         'smallint'     => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
 
+        # very long DEFAULT throws an ORA-24345
+        "number(15) DEFAULT to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ',null,substrb(userenv('CLIENT_INFO'),1,10)))" => {
+            data_type => 'numeric', size => [15,0], original => { data_type => 'number' },
+            default_value => \"to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ',null,substrb(userenv('CLIENT_INFO'),1,10)))"
+        },
+
         'decimal'      => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
         'dec'          => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },
         'numeric'      => { data_type => 'integer', original => { data_type => 'number', size => [38,0] } },