DBD-SQLite: applied a patch to fix column_info from VYLON

Changes

@@ -9,6 +9,8 @@ Changes for Perl extension DBD-SQLite
       under a very, very slow (virtual) machine. (ISHIGAKI)
     - Added a code to look for a compiler from Module::Install::Can.
       (ISHIGAKI)
+    - Fixed $dbh->column_info to work according to the spec in DBI and
+      added support for attached databases. (VLYON)
 
 1.26_03 Wed 12 Aug 2009
     - Updated to SQLite 3.6.17 (ISHIGAKI)

lib/DBD/SQLite.pm

@@ -306,8 +306,8 @@ END_SQL
                             if ($table_type !~ /^'.*'$/) {
                                     $table_type = "'" . $table_type . "'";
                             }
-                            $table_type_list = join(", ", @ttype_list);
                     }
+                    $table_type_list = join(', ', @ttype_list);
                     push @where, "TABLE_TYPE IN (\U$table_type_list)" if $table_type_list;
             }
             $sql .= ' WHERE ' . join("\n   AND ", @where ) . "\n" if @where;
@@ -324,7 +324,7 @@ sub primary_key_info {
     # This is a hack but much simpler than using pragma index_list etc
     # also the pragma doesn't list 'INTEGER PRIMARY KEY' autoinc PKs!
     my @pk_info;
-    my $sth_tables = $dbh->table_info($catalog, $schema, $table, '');
+    my $sth_tables = $dbh->table_info($catalog, $schema, $table, undef);
     while ( my $row = $sth_tables->fetchrow_hashref ) {
         my $sql = $row->{sqlite_sql} or next;
         next unless $sql =~ /(.*?)\s*PRIMARY\s+KEY\s*(?:\(\s*(.*?)\s*\))?/si;
@@ -423,21 +423,69 @@ my @COLUMN_INFO = qw(
     IS_NULLABLE
 );
 
-# Taken from Fey::Loader::SQLite
 sub column_info {
-    my($dbh, $catalog, $schema, $table, $column) = @_;
+    my ($dbh, $cat_val, $sch_val, $tbl_val, $col_val) = @_;
 
-    if ( defined $column and $column eq '%' ) {
+    if ( defined $col_val and $col_val eq '%' ) {
-        $column = undef;
+        $col_val = undef;
     }
 
-    my @cols        = ();
+    # Get a list of all tables ordered by TABLE_SCHEM, TABLE_NAME
-    my $position    = 0;
+    my $sql = <<'END_SQL';
-    my $sth_columns = $dbh->prepare("PRAGMA table_info('$table')");
+SELECT TABLE_SCHEM, tbl_name TABLE_NAME
+FROM (
+    SELECT 'main' TABLE_SCHEM, tbl_name
+    FROM sqlite_master
+    WHERE type IN ('table','view')
+UNION ALL
+    SELECT 'temp' TABLE_SCHEM, tbl_name
+    FROM sqlite_temp_master
+    WHERE type IN ('table','view')
+END_SQL
+
+    for my $db_name (_attached_database_list($dbh)) {
+        $sql .= <<"END_SQL";
+UNION ALL
+    SELECT '$db_name' TABLE_SCHEM, tbl_name
+    FROM "$db_name".sqlite_master
+    WHERE type IN ('table','view')
+END_SQL
+    }
+
+    $sql .= <<'END_SQL';
+UNION ALL
+    SELECT 'main' TABLE_SCHEM, 'sqlite_master' tbl_name
+UNION ALL
+    SELECT 'temp' TABLE_SCHEM, 'sqlite_temp_master' tbl_name
+)
+END_SQL
+
+    my @where;
+    if ( defined $sch_val ) {
+        push @where, "TABLE_SCHEM LIKE '$sch_val'";
+    }
+    if ( defined $tbl_val ) {
+        push @where, "TABLE_NAME LIKE '$tbl_val'";
+    }
+    $sql .= ' WHERE ' . join("\n   AND ", @where ) . "\n" if @where;
+    $sql .= " ORDER BY TABLE_SCHEM, TABLE_NAME\n";
+    my $sth_tables = $dbh->prepare($sql) or return undef;
+    $sth_tables->execute or return undef;
+
+    # Taken from Fey::Loader::SQLite
+    my @cols;
+    while ( my ($schema, $table) = $sth_tables->fetchrow_array ) {
+        my $sth_columns = $dbh->prepare(qq{PRAGMA "$schema".table_info("$table")});
         $sth_columns->execute;
-    while ( my $col_info = $sth_columns->fetchrow_hashref ) {
+
-        $position++;
+        for ( my $position = 0; my $col_info = $sth_columns->fetchrow_hashref; $position++ ) {
-        next if defined $column && $column ne $col_info->{name};
+            if ( defined $col_val ) {
+                # This must do a LIKE comparison
+                my $sth = $dbh->prepare("SELECT '$col_info->{name}' LIKE '$col_val'") or return undef;
+                $sth->execute or return undef;
+                # Skip columns that don't match $col_val
+                next unless ($sth->fetchrow_array)[0];
+            }
 
             my %col = (
                 TABLE_NAME       => $table,
@@ -465,18 +513,15 @@ sub column_info {
                 $col{IS_NULLABLE} = 'YES';
             }
 
-        foreach my $key ( @COLUMN_INFO ) {
-            next if exists $col{$key};
-            $col{$key} = undef;
-        }
-
             push @cols, \%col;
         }
         $sth_columns->finish;
+    }
+    $sth_tables->finish;
 
     my $sponge = DBI->connect("DBI:Sponge:", '','')
         or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
-    my $sth = $sponge->prepare( "column_info $table", {
+    $sponge->prepare( "column_info", {
         rows          => [ map { [ @{$_}{@COLUMN_INFO} ] } @cols ],
         NUM_OF_FIELDS => scalar @COLUMN_INFO,
         NAME          => [ @COLUMN_INFO ],
@@ -484,8 +529,6 @@ sub column_info {
         $sponge->err,
         $sponge->errstr,
     );
-
-    return $sth;
 }
 
 

t/16_column_info.t

@@ -7,7 +7,7 @@ BEGIN {
 }
 
 use t::lib::Test;
-use Test::More tests => 7;
+use Test::More tests => 10;
 use Test::NoWarnings;
 
 my $dbh = DBI->connect('dbi:SQLite:dbname=:memory:',undef,undef,{RaiseError => 1});
@@ -19,18 +19,26 @@ ok( $dbh->do(<<'END_SQL'), 'Created test table' );
     );
 END_SQL
 
+ok( $dbh->do(<<'END_SQL'), 'Created temp test table' );
+    CREATE TEMP TABLE test2 (
+        id INTEGER PRIMARY KEY NOT NULL,
+        flag INTEGER
+    );
+END_SQL
+
 my $sth = $dbh->column_info(undef, undef, 'test', undef);
 is $@, '', 'No error creating the table';
 
 ok $sth, 'We can get column information';
 
 my %expected = (
-    TYPE_NAME   => [qw[ INTEGER VARCHAR ]],
+    TYPE_NAME   => [qw( INTEGER VARCHAR )],
-    COLUMN_NAME => [qw[ ID NAME ]],
+    COLUMN_NAME => [qw( ID NAME )],
 );
 
 SKIP: {
-    if ($sth) {
+    skip( "The table didn't get created correctly or we can't get column information.", 5 ) unless $sth;
+
     my $info = $sth->fetchall_arrayref({});
 
     is( scalar @$info, 2, 'We got information on two columns' );
@@ -38,8 +46,18 @@ SKIP: {
     foreach my $item (qw( TYPE_NAME COLUMN_NAME )) {
         my @info = map { uc $_->{$item} } (@$info);
         is_deeply( \@info, $expected{$item}, "We got the right info in $item" );
-        };
-    } else {
-        skip( "The table didn't get created correctly or we can't get column information.", 3 );
     }
-};
+
+    $info = $dbh->column_info(undef, undef, 'test%', '%a%')->fetchall_arrayref({});
+
+    is( scalar @$info, 2, 'We matched information from multiple databases' );
+
+    my @fields = qw( TYPE_NAME COLUMN_NAME COLUMN_SIZE );
+    my @info = map [ @$_{@fields} ], @$info;
+    my $expected = [
+        [ 'VARCHAR', 'name', 255 ],
+        [ 'INTEGER', 'flag', undef ]
+    ];
+
+    is_deeply( \@info, $expected, 'We got the right info from multiple databases' );
+}