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 )
{
