mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-07 22:28:47 -04:00
new implementation for collation_needed, no more malloc -- should no longer leak
new API for global registry of collations, using a "write-once" tied hash
This commit is contained in:
parent
a87ac54afb
commit
ec38f98792
6 changed files with 148 additions and 67 deletions
|
@ -81,7 +81,6 @@ create_collation(dbh, name, func)
|
|||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
#if 0
|
||||
|
||||
static void
|
||||
collation_needed(dbh, callback)
|
||||
|
@ -94,7 +93,6 @@ collation_needed(dbh, callback)
|
|||
sqlite_db_collation_needed(aTHX_ dbh, callback );
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
static int
|
||||
progress_handler(dbh, n_opcodes, handler)
|
||||
|
|
47
dbdimp.c
47
dbdimp.c
|
@ -84,12 +84,13 @@ sqlite_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pas
|
|||
}
|
||||
DBIc_IMPSET_on(imp_dbh);
|
||||
|
||||
imp_dbh->in_tran = FALSE;
|
||||
imp_dbh->unicode = FALSE;
|
||||
imp_dbh->functions = newAV();
|
||||
imp_dbh->aggregates = newAV();
|
||||
imp_dbh->timeout = SQL_TIMEOUT;
|
||||
imp_dbh->handle_binary_nulls = FALSE;
|
||||
imp_dbh->in_tran = FALSE;
|
||||
imp_dbh->unicode = FALSE;
|
||||
imp_dbh->functions = newAV();
|
||||
imp_dbh->aggregates = newAV();
|
||||
imp_dbh->collation_needed_callback = newSVsv( &PL_sv_undef );
|
||||
imp_dbh->timeout = SQL_TIMEOUT;
|
||||
imp_dbh->handle_binary_nulls = FALSE;
|
||||
|
||||
sqlite3_busy_timeout(imp_dbh->db, SQL_TIMEOUT);
|
||||
|
||||
|
@ -172,6 +173,10 @@ sqlite_db_disconnect (SV *dbh, imp_dbh_t *imp_dbh)
|
|||
SvREFCNT_dec(imp_dbh->aggregates);
|
||||
imp_dbh->aggregates = (AV *)NULL;
|
||||
|
||||
sv_setsv(imp_dbh->collation_needed_callback, &PL_sv_undef);
|
||||
SvREFCNT_dec(imp_dbh->collation_needed_callback);
|
||||
imp_dbh->collation_needed_callback = (SV *)NULL;
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
@ -1312,26 +1317,27 @@ sqlite_db_create_collation(pTHX_ SV *dbh, const char *name, SV *func )
|
|||
return TRUE;
|
||||
}
|
||||
|
||||
#if 0
|
||||
void
|
||||
sqlite_db_collation_needed_dispatcher (
|
||||
void *info,
|
||||
sqlite3* db, /* unused, because we need the Perl dbh */
|
||||
int eTextRep,
|
||||
SV *dbh,
|
||||
sqlite3* db, /* unused */
|
||||
int eTextRep, /* unused */
|
||||
const char* collation_name
|
||||
)
|
||||
{
|
||||
dTHX;
|
||||
dSP;
|
||||
|
||||
D_imp_dbh(dbh);
|
||||
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(SP);
|
||||
XPUSHs( sv_2mortal ( newSVsv( ((collationNeededInfo*)info)->dbh ) ) );
|
||||
XPUSHs( sv_2mortal ( newSVsv(dbh ) ) );
|
||||
XPUSHs( sv_2mortal ( newSVpv( collation_name, 0) ) );
|
||||
PUTBACK;
|
||||
|
||||
call_sv( ((collationNeededInfo*)info)->callback, G_VOID );
|
||||
call_sv( imp_dbh->collation_needed_callback, G_VOID );
|
||||
SPAGAIN;
|
||||
|
||||
PUTBACK;
|
||||
|
@ -1344,25 +1350,14 @@ sqlite_db_collation_needed(pTHX_ SV *dbh, SV *callback )
|
|||
{
|
||||
D_imp_dbh(dbh);
|
||||
|
||||
SV *callback_sv = newSVsv(callback);
|
||||
collationNeededInfo* info = sqlite3_malloc(sizeof(collationNeededInfo));
|
||||
/* TODO: this struct should probably be freed at some point, not sure
|
||||
how and when */
|
||||
|
||||
/* Copy the handler ref so that it can be deallocated at disconnect */
|
||||
av_push( imp_dbh->functions, callback_sv );
|
||||
|
||||
/* the dispatcher will need both the callback and dbh, so build a struct */
|
||||
info->callback = callback_sv;
|
||||
info->dbh = dbh;
|
||||
/* remember the callback within the dbh */
|
||||
sv_setsv(imp_dbh->collation_needed_callback, callback);
|
||||
|
||||
/* Register the func within sqlite3 */
|
||||
(void) sqlite3_collation_needed( imp_dbh->db,
|
||||
(void*) info,
|
||||
(void*) SvOK(callback) ? dbh : NULL,
|
||||
sqlite_db_collation_needed_dispatcher );
|
||||
|
||||
}
|
||||
#endif
|
||||
|
||||
int
|
||||
sqlite_db_generic_callback_dispatcher( void *callback )
|
||||
|
|
11
dbdimp.h
11
dbdimp.h
|
@ -25,6 +25,7 @@ struct imp_dbh_st {
|
|||
int timeout;
|
||||
AV *functions;
|
||||
AV *aggregates;
|
||||
SV *collation_needed_callback;
|
||||
};
|
||||
|
||||
/* Statement Handle */
|
||||
|
@ -78,13 +79,6 @@ struct aggrInfo {
|
|||
int inited;
|
||||
};
|
||||
|
||||
#if 0
|
||||
typedef struct collationNeededInfo collationNeededInfo;
|
||||
struct collationNeededInfo {
|
||||
SV *dbh;
|
||||
SV *callback;
|
||||
};
|
||||
#endif
|
||||
|
||||
int sqlite_db_create_function(pTHX_ SV *dbh, const char *name, int argc, SV *func);
|
||||
int sqlite_db_enable_load_extension(pTHX_ SV *dbh, int onoff);
|
||||
|
@ -96,10 +90,7 @@ int sqlite_bind_col( SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV sql_type,
|
|||
int sqlite_db_busy_timeout (pTHX_ SV *dbh, int timeout );
|
||||
int sqlite_db_backup_from_file(pTHX_ SV *dbh, char *filename);
|
||||
int sqlite_db_backup_to_file(pTHX_ SV *dbh, char *filename);
|
||||
|
||||
#if 0
|
||||
void sqlite_db_collation_needed(pTHX_ SV *dbh, SV *callback );
|
||||
#endif
|
||||
SV* sqlite_db_commit_hook( pTHX_ SV *dbh, SV *hook );
|
||||
SV* sqlite_db_rollback_hook( pTHX_ SV *dbh, SV *hook );
|
||||
SV* sqlite_db_update_hook( pTHX_ SV *dbh, SV *hook );
|
||||
|
|
|
@ -27,10 +27,10 @@ BEGIN {
|
|||
|
||||
__PACKAGE__->bootstrap($VERSION);
|
||||
|
||||
%COLLATION = (
|
||||
perl => sub { $_[0] cmp $_[1] },
|
||||
perllocale => sub { use locale; $_[0] cmp $_[1] },
|
||||
);
|
||||
tie %COLLATION, 'DBD::SQLite::_WriteOnceHash';
|
||||
$COLLATION{perl} = sub { $_[0] cmp $_[1] };
|
||||
$COLLATION{perllocale} = sub { use locale; $_[0] cmp $_[1] };
|
||||
|
||||
|
||||
|
||||
my $methods_are_installed;
|
||||
|
@ -46,7 +46,7 @@ sub driver {
|
|||
DBD::SQLite::db->install_method('sqlite_create_function');
|
||||
DBD::SQLite::db->install_method('sqlite_create_aggregate');
|
||||
DBD::SQLite::db->install_method('sqlite_create_collation');
|
||||
# DBD::SQLite::db->install_method('sqlite_collation_needed');
|
||||
DBD::SQLite::db->install_method('sqlite_collation_needed');
|
||||
DBD::SQLite::db->install_method('sqlite_progress_handler');
|
||||
DBD::SQLite::db->install_method('sqlite_commit_hook');
|
||||
DBD::SQLite::db->install_method('sqlite_rollback_hook');
|
||||
|
@ -70,6 +70,8 @@ sub CLONE {
|
|||
undef $drh;
|
||||
}
|
||||
|
||||
|
||||
|
||||
package DBD::SQLite::dr;
|
||||
|
||||
sub connect {
|
||||
|
@ -120,22 +122,15 @@ sub connect {
|
|||
DBD::SQLite::db::_login($dbh, $real, $user, $auth) 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");
|
||||
|
||||
# XXX: Current collation_needed implementation is leaking badly.
|
||||
# Don't use it before we fix the leak.
|
||||
foreach my $collation_name(keys %DBD::SQLite::COLLATION) {
|
||||
install_collation($dbh, $collation_name);
|
||||
}
|
||||
$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");
|
||||
|
||||
|
||||
# HACK: Since PrintWarn = 0 doesn't seem to actually prevent warnings
|
||||
# in DBD::SQLite we set Warn to false if PrintWarn is false.
|
||||
unless ( $attr->{PrintWarn} ) {
|
||||
|
@ -498,8 +493,34 @@ sub column_info {
|
|||
return $sth;
|
||||
}
|
||||
|
||||
|
||||
#======================================================================
|
||||
# An internal tied hash package used for %DBD::SQLite::COLLATION, to
|
||||
# prevent people from unintentionally overriding globally registered collations.
|
||||
|
||||
package DBD::SQLite::_WriteOnceHash;
|
||||
require Tie::Hash;
|
||||
|
||||
our @ISA = qw(Tie::StdHash);
|
||||
|
||||
sub TIEHASH {
|
||||
bless {}, $_[0];
|
||||
}
|
||||
|
||||
sub STORE {
|
||||
! exists $_[0]->{$_[1]} or die "entry $_[1] already registered";
|
||||
$_[0]->{$_[1]} = $_[2];
|
||||
}
|
||||
|
||||
sub DELETE {
|
||||
die "deletion of entry $_[1] is forbidden";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
@ -725,8 +746,8 @@ The driver will check that this is a proper sorting function.
|
|||
=head2 $dbh->sqlite_collation_needed( $code_ref )
|
||||
|
||||
This method manually registers a callback function that will
|
||||
be invoked whenever an undefined collation sequence is required.
|
||||
The callback is invoked as
|
||||
be invoked whenever an undefined collation sequence is required
|
||||
from an SQL statement. The callback is invoked as
|
||||
|
||||
$code_ref->($dbh, $collation_name)
|
||||
|
||||
|
@ -1148,7 +1169,7 @@ is to set the parameter at connection time :
|
|||
);
|
||||
|
||||
|
||||
=head2 Adding user-defined collation
|
||||
=head2 Adding user-defined collations
|
||||
|
||||
The native SQLite API for adding user-defined collations is
|
||||
exposed through methods L</"sqlite_create_collation"> and
|
||||
|
@ -1175,8 +1196,24 @@ characters :
|
|||
my $rows = $dbh->selectall_arrayref($sql);
|
||||
|
||||
|
||||
The builtin C<perl> or C<perllocale> collations are also in
|
||||
the same hash and therefore could be overridden if needed.
|
||||
The builtin C<perl> or C<perllocale> collations are predefined
|
||||
in that same hash.
|
||||
|
||||
The COLLATION hash is a global registry within the current process;
|
||||
hence there is a risk of undesired side-effects. Therefore, to
|
||||
prevent action at distance, the hash is implemented as a "write-only"
|
||||
hash, that will happily accept new entries, but will raise an
|
||||
exception if any attempt is made to override or delete a existing
|
||||
entry (including the builtin C<perl> and C<perllocale>).
|
||||
|
||||
If you really, really need to change or delete an entry, you can
|
||||
always grab the tied object underneath C<%DBD::SQLite::COLLATION> ---
|
||||
but don't do that unless you really know what you are doing. Also
|
||||
observe that changes in the global hash will not modify existing
|
||||
collations in existing database handles: it will only affect new
|
||||
I<requests> for collations. In other words, if you want to change
|
||||
the behaviour of a collation within an existing C<$dbh>, you
|
||||
need to call the L</create_collation> method directly.
|
||||
|
||||
|
||||
=head1 BLOBS
|
||||
|
|
|
@ -6,11 +6,15 @@ BEGIN {
|
|||
$^W = 1;
|
||||
}
|
||||
|
||||
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
||||
use t::lib::Test qw/connect_ok dies @CALL_FUNCS/;
|
||||
use Test::More;
|
||||
BEGIN {
|
||||
my $COLLATION_TESTS = 10;
|
||||
my $WRITE_ONCE_TESTS = 4;
|
||||
|
||||
if ( $] >= 5.008005 ) {
|
||||
plan( tests => 10 * @CALL_FUNCS + 1 );
|
||||
plan( tests => $COLLATION_TESTS * @CALL_FUNCS +
|
||||
$WRITE_ONCE_TESTS + 1);
|
||||
} else {
|
||||
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
||||
}
|
||||
|
@ -38,9 +42,17 @@ sub no_accents ($$) {
|
|||
}
|
||||
|
||||
sub by_length ($$) {
|
||||
length($_[0]) <=> length($_[1])
|
||||
length($_[0]) <=> length($_[1])
|
||||
}
|
||||
|
||||
sub by_num ($$) {
|
||||
$_[0] <=> $_[1];
|
||||
}
|
||||
sub by_num_desc ($$) {
|
||||
$_[1] <=> $_[0];
|
||||
}
|
||||
|
||||
|
||||
# collation 'no_accents' will be automatically loaded on demand
|
||||
$DBD::SQLite::COLLATION{no_accents} = \&no_accents;
|
||||
|
||||
|
@ -49,6 +61,33 @@ $" = ", "; # to embed arrays into message strings
|
|||
|
||||
my $sql = "SELECT txt from collate_test ORDER BY txt";
|
||||
|
||||
|
||||
|
||||
# test interaction with the global COLLATION hash ("WriteOnce")
|
||||
|
||||
dies (sub {$DBD::SQLite::COLLATION{perl} = sub {}},
|
||||
qr/already registered/,
|
||||
"can't override builtin perl collation");
|
||||
|
||||
dies (sub {delete $DBD::SQLite::COLLATION{perl}},
|
||||
qr/deletion .* is forbidden/,
|
||||
"can't delete builtin perl collation");
|
||||
|
||||
# once a collation is registered, we can't override it ... unless by
|
||||
# digging into the tied object
|
||||
$DBD::SQLite::COLLATION{foo} = \&by_num;
|
||||
dies (sub {$DBD::SQLite::COLLATION{foo} = \&by_num_desc},
|
||||
qr/already registered/,
|
||||
"can't override registered collation");
|
||||
my $tied = tied %DBD::SQLite::COLLATION;
|
||||
delete $tied->{foo};
|
||||
$DBD::SQLite::COLLATION{foo} = \&by_num_desc; # override, no longer dies
|
||||
is($DBD::SQLite::COLLATION{foo}, \&by_num_desc, "overridden collation");
|
||||
|
||||
|
||||
|
||||
# now really test the collation functions
|
||||
|
||||
foreach my $call_func (@CALL_FUNCS) {
|
||||
|
||||
for my $use_unicode (0, 1) {
|
||||
|
@ -58,11 +97,11 @@ foreach my $call_func (@CALL_FUNCS) {
|
|||
|
||||
# populate test data
|
||||
my @words = qw{
|
||||
berger Bergèòe bergèòe Bergere
|
||||
HOT hôôe
|
||||
héôéòoclite héôaïòe hêôre héòaut
|
||||
HAT hâôer
|
||||
féôu fêôe fèöe ferme
|
||||
berger Bergère bergère Bergere
|
||||
HOT hôte
|
||||
hétéroclite hétaïre hêtre héraut
|
||||
HAT hâter
|
||||
fétu fête fève ferme
|
||||
};
|
||||
if ($use_unicode) {
|
||||
utf8::upgrade($_) foreach @words;
|
||||
|
@ -102,3 +141,6 @@ foreach my $call_func (@CALL_FUNCS) {
|
|||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -11,7 +11,7 @@ use vars qw{$VERSION @ISA @EXPORT @CALL_FUNCS};
|
|||
BEGIN {
|
||||
$VERSION = '1.26_01';
|
||||
@ISA = 'Exporter';
|
||||
@EXPORT = qw/connect_ok @CALL_FUNCS/;
|
||||
@EXPORT = qw/connect_ok dies @CALL_FUNCS/;
|
||||
|
||||
# Allow tests to load modules bundled in /inc
|
||||
unshift @INC, 'inc';
|
||||
|
@ -44,6 +44,24 @@ sub connect_ok {
|
|||
return $dbh;
|
||||
}
|
||||
|
||||
=head2 dies
|
||||
|
||||
dies(sub {...}, $regex_expected_error, $msg)
|
||||
|
||||
Tests that the given coderef (most probably a closure) dies with the
|
||||
expected error message.
|
||||
|
||||
=cut
|
||||
|
||||
sub dies {
|
||||
my ($coderef, $regex, $msg) = @_;
|
||||
eval {$coderef->()};
|
||||
my $exception = $@;
|
||||
Test::More::ok($exception =~ $regex,
|
||||
$msg || "dies with exception: $exception");
|
||||
}
|
||||
|
||||
|
||||
|
||||
=head2 @CALL_FUNCS
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue