mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-08 22:58:17 -04:00
DBD::SQLite: reverted 11571
This commit is contained in:
parent
6afec520c4
commit
5f01de2110
4 changed files with 61 additions and 39 deletions
4
Changes
4
Changes
|
@ -21,10 +21,6 @@ Changes for Perl extension DBD-SQLite
|
||||||
- Added preamble to generate ::sqlite3_[hc] modules to allow
|
- Added preamble to generate ::sqlite3_[hc] modules to allow
|
||||||
extension authors to use the same C source/header as they
|
extension authors to use the same C source/header as they
|
||||||
used to build DBD::SQLite itself. (ISHIGAKI)
|
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
|
1.29 Fri 8 Jan 2010
|
||||||
- Updated to SQLite 3.6.22 (DUNCAND)
|
- Updated to SQLite 3.6.22 (DUNCAND)
|
||||||
|
|
36
Makefile.PL
36
Makefile.PL
|
@ -190,9 +190,45 @@ if ( 0 ) {
|
||||||
|
|
||||||
@ARGV = grep( ! /SQLITE_LOCATION|USE_LOCAL_SQLITE/, @ARGV );
|
@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
|
# Prepare Compiler Options
|
||||||
|
|
|
@ -26,20 +26,18 @@ BEGIN {
|
||||||
|
|
||||||
__PACKAGE__->bootstrap($VERSION);
|
__PACKAGE__->bootstrap($VERSION);
|
||||||
|
|
||||||
# New or old API?
|
|
||||||
use constant NEWAPI => ($DBI::VERSION >= 1.608);
|
|
||||||
|
|
||||||
tie %COLLATION, 'DBD::SQLite::_WriteOnceHash';
|
tie %COLLATION, 'DBD::SQLite::_WriteOnceHash';
|
||||||
$COLLATION{perl} = sub { $_[0] cmp $_[1] };
|
$COLLATION{perl} = sub { $_[0] cmp $_[1] };
|
||||||
$COLLATION{perllocale} = sub { use locale; $_[0] cmp $_[1] };
|
$COLLATION{perllocale} = sub { use locale; $_[0] cmp $_[1] };
|
||||||
|
|
||||||
my $methods_are_installed = 0;
|
my $methods_are_installed;
|
||||||
|
|
||||||
sub driver {
|
sub driver {
|
||||||
return $drh if $drh;
|
return $drh if $drh;
|
||||||
|
|
||||||
if ( DBD::SQLite::NEWAPI and not $methods_are_installed ) {
|
if (!$methods_are_installed && $DBI::VERSION >= 1.608) {
|
||||||
DBI->setup_driver('DBD::SQLite');
|
DBI->setup_driver('DBD::SQLite');
|
||||||
|
|
||||||
DBD::SQLite::db->install_method('sqlite_last_insert_rowid');
|
DBD::SQLite::db->install_method('sqlite_last_insert_rowid');
|
||||||
DBD::SQLite::db->install_method('sqlite_busy_timeout');
|
DBD::SQLite::db->install_method('sqlite_busy_timeout');
|
||||||
DBD::SQLite::db->install_method('sqlite_create_function');
|
DBD::SQLite::db->install_method('sqlite_create_function');
|
||||||
|
@ -62,7 +60,6 @@ sub driver {
|
||||||
Version => $VERSION,
|
Version => $VERSION,
|
||||||
Attribution => 'DBD::SQLite by Matt Sergeant et al',
|
Attribution => 'DBD::SQLite by Matt Sergeant et al',
|
||||||
} );
|
} );
|
||||||
|
|
||||||
return $drh;
|
return $drh;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -119,14 +116,15 @@ sub connect {
|
||||||
# Hand off to the actual login function
|
# Hand off to the actual login function
|
||||||
DBD::SQLite::db::_login($dbh, $real, $user, $auth, $attr) or return undef;
|
DBD::SQLite::db::_login($dbh, $real, $user, $auth, $attr) or return undef;
|
||||||
|
|
||||||
# Register the on-demand collation installer and REGEXP function
|
# Register the on-demand collation installer
|
||||||
if ( DBD::SQLite::NEWAPI ) {
|
$DBI::VERSION >= 1.608
|
||||||
$dbh->sqlite_collation_needed( \&install_collation );
|
? $dbh->sqlite_collation_needed(\&install_collation)
|
||||||
$dbh->sqlite_create_function( "REGEXP", 2, \®exp );
|
: $dbh->func(\&install_collation, "collation_needed");
|
||||||
} else {
|
|
||||||
$dbh->func( \&install_collation, "collation_needed" );
|
# Register the REGEXP function
|
||||||
$dbh->func( "REGEXP", 2, \®exp, "create_function" );
|
$DBI::VERSION >= 1.608
|
||||||
}
|
? $dbh->sqlite_create_function("REGEXP", 2, \®exp)
|
||||||
|
: $dbh->func("REGEXP", 2, \®exp, "create_function");
|
||||||
|
|
||||||
# HACK: Since PrintWarn = 0 doesn't seem to actually prevent warnings
|
# HACK: Since PrintWarn = 0 doesn't seem to actually prevent warnings
|
||||||
# in DBD::SQLite we set Warn to false if PrintWarn is false.
|
# in DBD::SQLite we set Warn to false if PrintWarn is false.
|
||||||
|
@ -137,16 +135,14 @@ sub connect {
|
||||||
return $dbh;
|
return $dbh;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
sub install_collation {
|
sub install_collation {
|
||||||
my $dbh = shift;
|
my ($dbh, $collation_name) = @_;
|
||||||
my $name = shift;
|
my $collation = $DBD::SQLite::COLLATION{$collation_name}
|
||||||
my $collation = $DBD::SQLite::COLLATION{$name}
|
or die "can't install, unknown collation : $collation_name";
|
||||||
or die "can't install, unknown collation : $name";
|
$DBI::VERSION >= 1.608
|
||||||
if ( DBD::SQLite::NEWAPI ) {
|
? $dbh->sqlite_create_collation($collation_name => $collation)
|
||||||
$dbh->sqlite_create_collation( $name => $collation );
|
: $dbh->func($collation_name => $collation, "create_collation");
|
||||||
} else {
|
|
||||||
$dbh->func( $name => $collation, "create_collation" );
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
# default implementation for sqlite 'REGEXP' infix operator.
|
# default implementation for sqlite 'REGEXP' infix operator.
|
||||||
|
@ -157,6 +153,7 @@ sub regexp {
|
||||||
return scalar($_[1] =~ $_[0]);
|
return scalar($_[1] =~ $_[0]);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
package DBD::SQLite::db;
|
package DBD::SQLite::db;
|
||||||
|
|
||||||
sub prepare {
|
sub prepare {
|
||||||
|
@ -177,8 +174,8 @@ sub do {
|
||||||
my ($dbh, $statement, $attr, @bind_values) = @_;
|
my ($dbh, $statement, $attr, @bind_values) = @_;
|
||||||
|
|
||||||
my @copy = @{[@bind_values]};
|
my @copy = @{[@bind_values]};
|
||||||
my $rows = 0;
|
|
||||||
|
|
||||||
|
my $rows = 0;
|
||||||
while ($statement) {
|
while ($statement) {
|
||||||
my $sth = $dbh->prepare($statement, $attr) or return undef;
|
my $sth = $dbh->prepare($statement, $attr) or return undef;
|
||||||
$sth->execute(splice @copy, 0, $sth->{NUM_OF_PARAMS}) or return undef;
|
$sth->execute(splice @copy, 0, $sth->{NUM_OF_PARAMS}) or return undef;
|
||||||
|
@ -187,7 +184,6 @@ sub do {
|
||||||
last unless $dbh->FETCH('sqlite_allow_multiple_statements');
|
last unless $dbh->FETCH('sqlite_allow_multiple_statements');
|
||||||
$statement = $sth->{sqlite_unprepared_statements};
|
$statement = $sth->{sqlite_unprepared_statements};
|
||||||
}
|
}
|
||||||
|
|
||||||
# always return true if no error
|
# always return true if no error
|
||||||
return ($rows == 0) ? "0E0" : $rows;
|
return ($rows == 0) ? "0E0" : $rows;
|
||||||
}
|
}
|
||||||
|
@ -385,8 +381,8 @@ sub primary_key_info {
|
||||||
NUM_OF_FIELDS => scalar @names,
|
NUM_OF_FIELDS => scalar @names,
|
||||||
NAME => \@names,
|
NAME => \@names,
|
||||||
}) or return $dbh->DBI::set_err(
|
}) or return $dbh->DBI::set_err(
|
||||||
$sponge->err,
|
$sponge->err(),
|
||||||
$sponge->errstr,
|
$sponge->errstr()
|
||||||
);
|
);
|
||||||
return $sth;
|
return $sth;
|
||||||
}
|
}
|
||||||
|
|
|
@ -12,7 +12,7 @@ use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||||
use Test::More;
|
use Test::More;
|
||||||
use Test::NoWarnings;
|
use Test::NoWarnings;
|
||||||
|
|
||||||
plan tests => 10 * @CALL_FUNCS + 1;
|
plan tests => 9 * @CALL_FUNCS + 1;
|
||||||
|
|
||||||
my $show_diag = 0;
|
my $show_diag = 0;
|
||||||
foreach my $call_func (@CALL_FUNCS) {
|
foreach my $call_func (@CALL_FUNCS) {
|
||||||
|
@ -21,12 +21,6 @@ foreach my $call_func (@CALL_FUNCS) {
|
||||||
SCOPE: {
|
SCOPE: {
|
||||||
my $dbh = connect_ok();
|
my $dbh = connect_ok();
|
||||||
ok( $dbh->{sqlite_version}, '->{sqlite_version} 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' );
|
is( $dbh->{AutoCommit}, 1, 'AutoCommit is on by default' );
|
||||||
diag("sqlite_version=$dbh->{sqlite_version}") unless $show_diag++;
|
diag("sqlite_version=$dbh->{sqlite_version}") unless $show_diag++;
|
||||||
ok( $dbh->$call_func('busy_timeout'), 'Found initial busy_timeout' );
|
ok( $dbh->$call_func('busy_timeout'), 'Found initial busy_timeout' );
|
||||||
|
|
Loading…
Add table
Reference in a new issue