diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm index 689ecd8..ae9e634 100644 --- a/lib/DBD/SQLite.pm +++ b/lib/DBD/SQLite.pm @@ -11,7 +11,7 @@ BEGIN { @ISA = ('DynaLoader'); } -use vars qw{$err $errstr $state $drh }; +use vars qw{$err $errstr $state $drh $sqlite_version}; __PACKAGE__->bootstrap($VERSION); @@ -284,12 +284,75 @@ return; # XXX code just copied from DBD::Oracle, not yet thought about } -1; +# Taken from Fey::Loader::SQLite +sub column_info { + my($dbh, $catalog, $schema, $table, $column) = @_; + + $column = undef + if defined $column && $column eq '%'; + + my $sth_columns = $dbh->prepare( qq{PRAGMA table_info('$table')} ); + $sth_columns->execute; + + my @names = qw( TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME + DATA_TYPE TYPE_NAME COLUMN_SIZE BUFFER_LENGTH + DECIMAL_DIGITS NUM_PREC_RADIX NULLABLE + REMARKS COLUMN_DEF SQL_DATA_TYPE SQL_DATETIME_SUB + CHAR_OCTET_LENGTH ORDINAL_POSITION IS_NULLABLE + ); + + my @cols; + while ( my $col_info = $sth_columns->fetchrow_hashref ) { + next if defined $column && $column ne $col_info->{name}; + + my %col; + + $col{TABLE_NAME} = $table; + $col{COLUMN_NAME} = $col_info->{name}; + + my $type = $col_info->{type}; + if ( $type =~ s/(\w+)\((\d+)(?:,(\d+))?\)/$1/ ) { + $col{COLUMN_SIZE} = $2; + $col{DECIMAL_DIGITS} = $3; + } + + $col{TYPE_NAME} = $type; + + $col{COLUMN_DEF} = $col_info->{dflt_value} + if defined $col_info->{dflt_value}; + + if ( $col_info->{notnull} ) { + $col{NULLABLE} = 0; + $col{IS_NULLABLE} = 'NO'; + } + else { + $col{NULLABLE} = 1; + $col{IS_NULLABLE} = 'YES'; + } + + for my $key (@names) { + $col{$key} = undef + unless exists $col{$key}; + } + + push @cols, \%col; + } + + 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", { + rows => [ map { [ @{$_}{@names} ] } @cols ], + NUM_OF_FIELDS => scalar @names, + NAME => \@names, + }) or return $dbh->DBI::set_err($sponge->err(), $sponge->errstr()); + return $sth; +} + __END__ =head1 NAME -DBD::SQLite - Self Contained SQLite RDBMS in a DBI Driver +DBD::SQLite - Self Contained RDBMS in a DBI Driver =head1 SYNOPSIS @@ -399,7 +462,7 @@ Set the current busy timeout. The timeout is in milliseconds. =head2 $dbh->func( $name, $argc, $func_ref, "create_function" ) -This method will register a new function which will be useable in SQL +This method will register a new function which will be useable in an SQL query. The method's parameters are: =over @@ -640,6 +703,8 @@ Wolfgang Sourdeau Ewolfgang@logreport.orgE Adam Kennedy Eadamk@cpan.orgE +Max Maischein Ecorion@cpan.orgE + =head1 COPYRIGHT The bundled SQLite is Public Domain. @@ -650,6 +715,8 @@ Some parts copyright 2008 Francis J. Lacoste and Wolfgang Sourdeau. Some parts copyright 2008 - 2009 Adam Kennedy. +Some parts taken from L. + This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/t/column-info.t b/t/column-info.t new file mode 100644 index 0000000..da28317 --- /dev/null +++ b/t/column-info.t @@ -0,0 +1,53 @@ +#!/usr/bin/perl -w +BEGIN { + local $@; + unless (eval { require Test::More; 1 }) { + print "1..0 # Skip need Test::More\n"; + exit; + } +} +use strict; +use Test::More tests => 7; + +BEGIN { + use_ok 'DBD::SQLite' + or BAIL_OUT 'DBD::SQLite(::Amalgamation) failed to load. No sense in continuing.'; + no warnings 'once'; + diag "Testing DBD::SQLite version '$DBD::SQLite::VERSION' on DBI '$DBI::VERSION'"; + + #*DBD::SQLite::db::column_info = \&DBD::SQLite::db::_sqlite_column_info; +}; +use DBI; + +my $dbh = DBI->connect('dbi:SQLite:dbname=:memory:',undef,undef,{RaiseError => 1}); + +ok $dbh->do(<<''), 'Created test table'; + CREATE TABLE test ( + id INTEGER PRIMARY KEY NOT NULL, + name VARCHAR(255) + ); + +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 ]], + COLUMN_NAME => [qw[ ID NAME ]], +); + +SKIP: { + if ($sth) { + my $info = $sth->fetchall_arrayref({}); + + is scalar @$info, 2, 'We got information on two columns'; + + for 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; + } +};