From 6afec520c40124b981d89833ebc072fb3158c049 Mon Sep 17 00:00:00 2001 From: Adam Kennedy Date: Wed, 10 Mar 2010 11:42:26 +0000 Subject: [PATCH] Added tests for the sqlite_source attribute, but I lack the C-fu to make it work --- Changes | 4 ++++ Makefile.PL | 38 +---------------------------------- lib/DBD/SQLite.pm | 50 +++++++++++++++++++++++++---------------------- t/02_logon.t | 8 +++++++- 4 files changed, 39 insertions(+), 61 deletions(-) diff --git a/Changes b/Changes index 67fd6da..a646efc 100644 --- a/Changes +++ b/Changes @@ -21,6 +21,10 @@ Changes for Perl extension DBD-SQLite - Added preamble to generate ::sqlite3_[hc] modules to allow extension authors to use the same C source/header as they used to build DBD::SQLite itself. (ISHIGAKI) + - The preamble was subsequently moved as too heavy. Instead + extension authors should check the $dbh->{sqlite_source} + attribute instead for the location of the source code used + to build DBD::SQLite with (ADAMK) 1.29 Fri 8 Jan 2010 - Updated to SQLite 3.6.22 (DUNCAND) diff --git a/Makefile.PL b/Makefile.PL index 421a8af..5fa4f0e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -190,45 +190,9 @@ if ( 0 ) { @ARGV = grep( ! /SQLITE_LOCATION|USE_LOCAL_SQLITE/, @ARGV ); -foreach my $file (qw/sqlite3.h sqlite3.c/) { - (my $pm = $file) =~ tr/./_/; - print "generating lib/DBD/SQLite/$pm.pm\n"; - open my $fh, '>', "lib/DBD/SQLite/$pm.pm" or die $!; - print $fh <<"EOT"; -package DBD::SQLite::$pm; -use strict; -our \$CODE = do { local \$/; }; -sub get { - my (\$class, \$file, \$out) = \@_; - my \$got; - if (\$file) { - (\$got) = \$CODE =~ m{( - /\\*+[ ]Begin[ ]file[ ]\$file[ ]\\*+ - .+? - /\\*+[ ]End[ ]of[ ]\$file[ ]\\*+/ - )}sx; - } - else { - \$got = \$CODE; - } - if (\$got && \$out) { - open my \$fh, '>', \$out or die \$!; - print \$fh \$got; - } - return \$got ? \$got : ''; -} -1; -\__DATA__ -EOT - print $fh do { - local $/; - open my $in, '<', $file or die $!; - <$in>; - }; -} ##################################################################### # Prepare Compiler Options @@ -287,7 +251,7 @@ WriteMakefile( ABSTRACT => 'Self Contained SQLite RDBMS in a DBI Driver', VERSION_FROM => 'lib/DBD/SQLite.pm', AUTHOR => 'Adam Kennedy ', - # Release manager (can this be an array?) + # Release manager (can this be an array?) PREREQ_PM => { 'Tie::Hash' => 0, 'File::Spec' => (WINLIKE ? '3.27' : '0.82'), diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm index 19f803e..6e17ef5 100644 --- a/lib/DBD/SQLite.pm +++ b/lib/DBD/SQLite.pm @@ -26,18 +26,20 @@ BEGIN { __PACKAGE__->bootstrap($VERSION); +# New or old API? +use constant NEWAPI => ($DBI::VERSION >= 1.608); + tie %COLLATION, 'DBD::SQLite::_WriteOnceHash'; $COLLATION{perl} = sub { $_[0] cmp $_[1] }; $COLLATION{perllocale} = sub { use locale; $_[0] cmp $_[1] }; -my $methods_are_installed; +my $methods_are_installed = 0; sub driver { return $drh if $drh; - if (!$methods_are_installed && $DBI::VERSION >= 1.608) { + if ( DBD::SQLite::NEWAPI and not $methods_are_installed ) { DBI->setup_driver('DBD::SQLite'); - DBD::SQLite::db->install_method('sqlite_last_insert_rowid'); DBD::SQLite::db->install_method('sqlite_busy_timeout'); DBD::SQLite::db->install_method('sqlite_create_function'); @@ -60,6 +62,7 @@ sub driver { Version => $VERSION, Attribution => 'DBD::SQLite by Matt Sergeant et al', } ); + return $drh; } @@ -116,15 +119,14 @@ sub connect { # Hand off to the actual login function DBD::SQLite::db::_login($dbh, $real, $user, $auth, $attr) or return undef; - # Register the on-demand collation installer - $DBI::VERSION >= 1.608 - ? $dbh->sqlite_collation_needed(\&install_collation) - : $dbh->func(\&install_collation, "collation_needed"); - - # Register the REGEXP function - $DBI::VERSION >= 1.608 - ? $dbh->sqlite_create_function("REGEXP", 2, \®exp) - : $dbh->func("REGEXP", 2, \®exp, "create_function"); + # Register the on-demand collation installer and REGEXP function + if ( DBD::SQLite::NEWAPI ) { + $dbh->sqlite_collation_needed( \&install_collation ); + $dbh->sqlite_create_function( "REGEXP", 2, \®exp ); + } else { + $dbh->func( \&install_collation, "collation_needed" ); + $dbh->func( "REGEXP", 2, \®exp, "create_function" ); + } # HACK: Since PrintWarn = 0 doesn't seem to actually prevent warnings # in DBD::SQLite we set Warn to false if PrintWarn is false. @@ -135,14 +137,16 @@ sub connect { return $dbh; } - sub install_collation { - my ($dbh, $collation_name) = @_; - my $collation = $DBD::SQLite::COLLATION{$collation_name} - or die "can't install, unknown collation : $collation_name"; - $DBI::VERSION >= 1.608 - ? $dbh->sqlite_create_collation($collation_name => $collation) - : $dbh->func($collation_name => $collation, "create_collation"); + my $dbh = shift; + my $name = shift; + my $collation = $DBD::SQLite::COLLATION{$name} + or die "can't install, unknown collation : $name"; + if ( DBD::SQLite::NEWAPI ) { + $dbh->sqlite_create_collation( $name => $collation ); + } else { + $dbh->func( $name => $collation, "create_collation" ); + } } # default implementation for sqlite 'REGEXP' infix operator. @@ -153,7 +157,6 @@ sub regexp { return scalar($_[1] =~ $_[0]); } - package DBD::SQLite::db; sub prepare { @@ -174,8 +177,8 @@ sub do { my ($dbh, $statement, $attr, @bind_values) = @_; my @copy = @{[@bind_values]}; - my $rows = 0; + while ($statement) { my $sth = $dbh->prepare($statement, $attr) or return undef; $sth->execute(splice @copy, 0, $sth->{NUM_OF_PARAMS}) or return undef; @@ -184,6 +187,7 @@ sub do { last unless $dbh->FETCH('sqlite_allow_multiple_statements'); $statement = $sth->{sqlite_unprepared_statements}; } + # always return true if no error return ($rows == 0) ? "0E0" : $rows; } @@ -381,8 +385,8 @@ sub primary_key_info { NUM_OF_FIELDS => scalar @names, NAME => \@names, }) or return $dbh->DBI::set_err( - $sponge->err(), - $sponge->errstr() + $sponge->err, + $sponge->errstr, ); return $sth; } diff --git a/t/02_logon.t b/t/02_logon.t index 4629c84..99565c1 100644 --- a/t/02_logon.t +++ b/t/02_logon.t @@ -12,7 +12,7 @@ use t::lib::Test qw/connect_ok @CALL_FUNCS/; use Test::More; use Test::NoWarnings; -plan tests => 9 * @CALL_FUNCS + 1; +plan tests => 10 * @CALL_FUNCS + 1; my $show_diag = 0; foreach my $call_func (@CALL_FUNCS) { @@ -21,6 +21,12 @@ foreach my $call_func (@CALL_FUNCS) { SCOPE: { my $dbh = connect_ok(); ok( $dbh->{sqlite_version}, '->{sqlite_version} ok' ); + my $version = $dbh->{sqlite_version}; + is( + $dbh->{sqlite_source}, + "http://sqlite.org/sqlite-amalgamation.$version.tar.gz", + '->{sqlite_source} ok', + ); is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' ); diag("sqlite_version=$dbh->{sqlite_version}") unless $show_diag++; ok( $dbh->$call_func('busy_timeout'), 'Found initial busy_timeout' );