mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-08 14:48:32 -04:00
Added tests for the sqlite_source attribute, but I lack the C-fu to make it work
This commit is contained in:
Adam Kennedy
parent
4beeded766
commit
6afec520c4
4 changed files with 39 additions and 61 deletions
4
Changes
4
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)
|
||||
|
|
|
|||
38
Makefile.PL
38
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 \$/; <DATA> };
|
||||
|
||||
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 <adamk@cpan.org>',
|
||||
# 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'),
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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' );
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue