mirror of
https://github.com/DBD-SQLite/DBD-SQLite
synced 2025-06-08 06:38:12 -04:00
3714dc6954
- Added support for set_authorizer (DAMI)
- Added support for collation_needed(), and reorganised driver API
for user-defined collations (DAMI)
- Exported constants from sqlite3.h into DBD::SQLite namespace (DAMI)
- Added support in t/lib/Test.pm for checking both versions of
driver-private methods ("func" / "sqlite_*") (DAMI)
- Removed unused and obsolete "list_tables" from SQLite.xs (DAMI)
- Added a default implementation for the REGEXP infix operator (DAMI)
106 lines
2.7 KiB
Perl
106 lines
2.7 KiB
Perl
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
BEGIN {
|
|
$| = 1;
|
|
$^W = 1;
|
|
}
|
|
|
|
use t::lib::Test qw/connect_ok @CALL_FUNCS/;
|
|
use Test::More;
|
|
use Test::NoWarnings;
|
|
BEGIN {
|
|
plan skip_all => 'requires DBI v1.608' if $DBI::VERSION < 1.608;
|
|
|
|
if ( $] >= 5.008005 ) {
|
|
plan( tests => 10 * @CALL_FUNCS + 1 );
|
|
} else {
|
|
plan( skip_all => 'Unicode is not supported before 5.8.5' );
|
|
}
|
|
}
|
|
use Encode qw/decode/;
|
|
use DBD::SQLite;
|
|
|
|
BEGIN {
|
|
# Sadly perl for windows (and probably sqlite, too) may hang
|
|
# if the system locale doesn't support european languages.
|
|
# en-us should be a safe default. if it doesn't work, use 'C'.
|
|
if ( $^O eq 'MSWin32') {
|
|
use POSIX 'locale_h';
|
|
setlocale(LC_COLLATE, 'en-us');
|
|
}
|
|
}
|
|
|
|
# ad hoc collation functions
|
|
sub no_accents ($$) {
|
|
my ( $a, $b ) = map lc, @_;
|
|
tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý]
|
|
[aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b;
|
|
$a cmp $b;
|
|
}
|
|
|
|
sub by_length ($$) {
|
|
length($_[0]) <=> length($_[1])
|
|
}
|
|
|
|
# collation 'no_accents' will be automatically loaded on demand
|
|
$DBD::SQLite::COLLATION{no_accents} = \&no_accents;
|
|
|
|
|
|
$" = ", "; # to embed arrays into message strings
|
|
|
|
my $sql = "SELECT txt from collate_test ORDER BY txt";
|
|
|
|
foreach my $call_func (@CALL_FUNCS) {
|
|
|
|
for my $use_unicode (0, 1) {
|
|
|
|
# connect
|
|
my $dbh = connect_ok( RaiseError => 1, unicode => $use_unicode );
|
|
|
|
# populate test data
|
|
my @words = qw{
|
|
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;
|
|
}
|
|
|
|
$dbh->do( 'CREATE TEMP TABLE collate_test ( txt )' );
|
|
$dbh->do( "INSERT INTO collate_test VALUES ( '$_' )" ) foreach @words;
|
|
|
|
# test builtin collation "perl"
|
|
my @sorted = sort @words;
|
|
my $db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perl");
|
|
is_deeply(\@sorted, $db_sorted, "collate perl (@sorted // @$db_sorted)");
|
|
|
|
SCOPE: {
|
|
use locale;
|
|
@sorted = sort @words;
|
|
}
|
|
|
|
# test builtin collation "perllocale"
|
|
$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perllocale");
|
|
is_deeply(\@sorted, $db_sorted,
|
|
"collate perllocale (@sorted // @$db_sorted)");
|
|
|
|
# test additional collation "no_accents"
|
|
@sorted = sort no_accents @words;
|
|
$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE no_accents");
|
|
is_deeply(\@sorted, $db_sorted,
|
|
"collate no_accents (@sorted // @$db_sorted)");
|
|
|
|
|
|
# manual addition of a collation for this dbh
|
|
$dbh->$call_func(by_length => \&by_length, "create_collation");
|
|
@sorted = sort by_length @words;
|
|
$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE by_length");
|
|
is_deeply(\@sorted, $db_sorted,
|
|
"collate by_length (@sorted // @$db_sorted)");
|
|
}
|
|
}
|
|
|