[svn:dbi] r14198 - in dbi/trunk/lib: DBD DBI/DBD

Author: REHSACK
Date: Tue Jun 29 06:06:02 2010
New Revision: 14198

Modified:
   dbi/trunk/lib/DBD/DBM.pm
   dbi/trunk/lib/DBD/File.pm
   dbi/trunk/lib/DBI/DBD/SqlEngine.pm

Log:
Try a workaround fix for table_defs related FETCH results in DBD::CSV


Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm	(original)
+++ dbi/trunk/lib/DBD/DBM.pm	Tue Jun 29 06:06:02 2010
@@ -204,17 +204,15 @@
 {
     my ( $sth, $attr ) = @_;
 
-    my @colnames = $sth->sql_get_colnames();
-
-    $attr eq "TYPE" and return [ map { "CHAR" } @colnames ];
-
-    # XXX not really known ...
-    # $attr eq "PRECISION" and
+    if( $attr eq "NULLABLE" )
+    {
+	my @colnames = $sth->sql_get_colnames();
 
-    # XXX only BerkeleyDB fails having NULL values for non-MLDBM databases,
-    #     none accept it for key - but it requires more knowledge between
-    #     queries and tables storage to return fully correct information
-    $attr eq "NULLABLE" and return [ map { 0 } @colnames ];
+	# XXX only BerkeleyDB fails having NULL values for non-MLDBM databases,
+	#     none accept it for key - but it requires more knowledge between
+	#     queries and tables storage to return fully correct information
+	$attr eq "NULLABLE" and return [ map { 0 } @colnames ];
+    }
 
     return $sth->SUPER::FETCH($attr);
 }    # FETCH

Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm	(original)
+++ dbi/trunk/lib/DBD/File.pm	Tue Jun 29 06:06:02 2010
@@ -688,6 +688,54 @@
 @DBD::File::st::ISA           = qw(DBI::DBD::SqlEngine::st);
 $DBD::File::st::imp_data_size = 0;
 
+my %supported_attrs = (
+    TYPE      => 1,
+    PRECISION => 1,
+    NULLABLE  => 1,
+    );
+
+sub FETCH
+{
+    my ($sth, $attr) = @_;
+
+    if ($supported_attrs{$attr}) {
+	my $stmt = $sth->{sql_stmt};
+
+	if (exists $sth->{ImplementorClass} &&
+	    exists $sth->{sql_stmt} &&
+	    $sth->{sql_stmt}->isa("SQL::Statement")) {
+	    # fill overall_defs unless we know
+	    unless (exists ($sth->{f_overall_defs}) && ref $sth->{f_overall_defs}) {
+		my $all_meta = $sth->{Database}->func( "*", "table_defs", "get_file_meta" );
+		while (my ($tbl, $meta) = each %$all_meta) {
+		    next unless exists $meta->{table_defs} && ref $meta->{table_defs};
+		    foreach my $col (keys %{$meta->{table_defs}{columns}}) {
+			$sth->{f_overall_defs}{$col} = $meta->{table_defs}{columns}{$col};
+			}
+		    }
+		}
+
+	    my @colnames = $sth->sql_get_colnames();
+
+	    $attr eq "TYPE"      and
+		return [ map { $sth->{f_overall_defs}{$_}{data_type}   || "CHAR" }
+			    @colnames ];
+
+	    $attr eq "PRECISION" and
+		return [ map { $sth->{f_overall_defs}{$_}{data_length} || 0 }
+			    @colnames ];
+
+	    $attr eq "NULLABLE"  and
+		return [ map { ( grep m/^NOT NULL$/ =>
+			    @{ $sth->{f_overall_defs}{$_}{constraints} || [] } )
+			       ? 0 : 1 }
+			    @colnames ];
+	    }
+	}
+
+    return $sth->SUPER::FETCH ($attr);
+}
+
 # ====== SQL::STATEMENT ========================================================
 
 package DBD::File::Statement;
@@ -1003,6 +1051,12 @@
         croak "Cannot find appropriate file for table '$attrs->{table}'";
     $attrs->{table} = $tblnm;
 
+    # Being a bit dirty here, as SQL::Statement::Structure does not offer
+    # me an interface to the data I want
+    if ($flags->{createMode} && $data->{sql_stmt}{table_defs}) {
+	$meta->{table_defs} = $data->{sql_stmt}{table_defs};
+	}
+
     $className->open_file ($meta, $attrs, $flags);
 
     my $columns = {};

Modified: dbi/trunk/lib/DBI/DBD/SqlEngine.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD/SqlEngine.pm	(original)
+++ dbi/trunk/lib/DBI/DBD/SqlEngine.pm	Tue Jun 29 06:06:02 2010
@@ -245,6 +245,8 @@
             $sth->STORE( "sql_stmt", $stmt );
             $sth->STORE( "sql_params", [] );
             $sth->STORE( "NUM_OF_PARAMS", scalar( $stmt->params() ) );
+	    my @colnames = $sth->sql_get_colnames();
+	    $sth->STORE( "NUM_OF_FIELDS", scalar @colnames );
         }
     }
     return $sth;
@@ -793,12 +795,14 @@
     }
     elsif ( $sth->{sql_stmt}->isa('SQL::Statement') )
     {
-        my $struct  = $sth->{sql_stmt}{struct} || {};
-	my @coldefs = @{ $struct->{column_defs} || [] };
+        my $stmt    = $sth->{sql_stmt} || {};
+	my @coldefs = @{ $stmt->{column_defs} || [] };
           @colnames = map { $_->{name} || $_->{value} } @coldefs;
     }
     @colnames = $sth->{sql_stmt}->column_names() unless (@colnames);
 
+    @colnames = () if( grep { m/\*/ } @colnames );
+
     return @colnames;
 }
 
@@ -806,6 +810,8 @@
 {
     my ( $sth, $attrib ) = @_;
 
+=pod
+
     if ( $attrib =~ m/^NAME(?:|_lc|_uc)$/ )
     {
 	my @cn = $sth->sql_get_colnames();
@@ -814,12 +820,19 @@
 	       : @cn ];
     }
 
-    if ( $attrib eq "NULLABLE" )
-    {
-        my @colnames = $sth->sql_get_colnames();
-        @colnames or return;
-        return [ (1) x @colnames ];
-    }
+=cut
+
+    $attrib eq "NAME" and return [ $sth->sql_get_colnames() ];
+
+    $attrib eq "TYPE"      and return [ ("CHAR") x scalar $sth->sql_get_colnames() ];
+    $attrib eq "PRECISION" and return [ (0) x scalar $sth->sql_get_colnames() ];
+    $attrib eq "NULLABLE"  and return [ (1) x scalar $sth->sql_get_colnames() ];
+#   if ( $attrib eq "NULLABLE" )
+#   {
+#       my @colnames = ;
+#       @colnames or return;
+#       return [ (1) x @colnames ];
+#   }
 
     if ( $attrib eq lc $attrib )
     {