diff --git a/Changes b/Changes index f87bf96..187c502 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,7 @@ Changes for Perl extension DBD-SQLite. -1.19_10 not yet released +1.19_10 Mon 6 Apr 2009 + - A few more tests moved to Test::More (ADAMK) - Resolved #40594: $sth->{NULLABLE} implementation (ISHIGAKI) - Resolved #29629: sqlite where length issue (actually this has been fixed before) (ISHIGAKI) @@ -8,6 +9,7 @@ Changes for Perl extension DBD-SQLite. - Resolved #42940: DBD-SQLite make test faild (ADAMK) - Resolved #26460: Sorting numeric values in aggregate functions (ADAMK) - Resolved #32889: prepare_cached does not work correctly (ADAMK) + - Resolved #34828: Please add support for user-defined collations (ADAMK) 1.19_09 Sun 5 Apr 2009 - Require perl 5.6 because dependencies require it diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm index bc8902b..a791657 100644 --- a/lib/DBD/SQLite.pm +++ b/lib/DBD/SQLite.pm @@ -8,7 +8,7 @@ use DynaLoader (); use vars qw($VERSION @ISA); use vars qw{$err $errstr $drh $sqlite_version}; BEGIN { - $VERSION = '1.19_09'; + $VERSION = '1.19_10'; @ISA = ('DynaLoader'); # Driver singleton @@ -65,7 +65,7 @@ sub connect { DBD::SQLite::db::_login($dbh, $real, $user, $auth) or return undef; # install perl collations - my $perl_collation = sub {$_[0] cmp $_[1]}; + my $perl_collation = sub { $_[0] cmp $_[1] }; my $perl_locale_collation = sub { use locale; $_[0] cmp $_[1] }; $dbh->func( "perl", $perl_collation, "create_collation" ); $dbh->func( "perllocale", $perl_locale_collation, "create_collation" ); @@ -485,7 +485,7 @@ Retrieve the current busy timeout. Set the current busy timeout. The timeout is in milliseconds. -=head2 $dbh->func( $name, $argc, $func_ref, "create_function" ) +=head2 $dbh->func( $name, $argc, $code_ref, "create_function" ) This method will register a new function which will be useable in an SQL query. The method's parameters are: @@ -502,7 +502,7 @@ be used from SQL. The number of arguments taken by the function. If this number is -1, the function can take any number of arguments. -=item $func_ref +=item $code_ref This should be a reference to the function's implementation. @@ -545,6 +545,31 @@ The aggregator interface consists of defining three methods: =over +=head2 $dbh->func( $name, $code_ref, "create_collation" ) + +This method will register a new function which will be useable in an SQL +query as a COLLATE option for sorting. The method's parameters are: + +=over + +=item $name + +The name of the function. This is the name of the function as it will +be used from SQL. + +=item $code_ref + +This should be a reference to the function's implementation. + +=back + +By default, the collations "perl" and "perllocale" are created for you. + +These allow sorting in Perl terms using "cmp", in both locale and non-locale +forms. For example, the following does a locale-aware Perl cmp sort. + + SELECT * FROM foo ORDER BY name COLLATE perllocale + =item new() This method will be called once to create an object which should diff --git a/t/12_unicode.t b/t/12_unicode.t index dad5dd4..13dbc72 100644 --- a/t/12_unicode.t +++ b/t/12_unicode.t @@ -9,6 +9,8 @@ BEGIN { $^W = 1; } +use Test::More tests => 16; +use Test::NoWarnings; use t::lib::Test; # @@ -18,20 +20,6 @@ use t::lib::Test; use Carp; use DBI qw(:sql_types); -do 't/lib.pl'; -if ($@) { - print STDERR "Error while executing lib.pl: $@\n"; - exit 10; -} - -BEGIN {if ($] < 5.006) { - print <<"BAIL_OUT"; -1..0 -# SKIPPING - No UTF-8 support in this Perl release -BAIL_OUT - exit 0; -}} - no bytes; # Unintuitively, still has the effect of loading bytes.pm :-) # Portable albeit kludgy: detects UTF-8 promotion of $hibyte from @@ -39,45 +27,32 @@ no bytes; # Unintuitively, still has the effect of loading bytes.pm :-) sub is_utf8 { no bytes; my ($string) = @_; - my $hibyte = pack("C", 0xe9); - + my $hibyte = pack("C", 0xe9); my @lengths = map { bytes::length($_) } ($string, $string . $hibyte); return ($lengths[0] + 1 < $lengths[1]); } -### Test code starts here - -Testing(); -use vars qw{$numTests}; -$numTests = 14; -Testing(); - # First, some UTF-8 framework self-test: -my @isochars = (ord("K"), 0xf6, ord("n"), ord("i"), ord("g")); - +my @isochars = (ord("K"), 0xf6, ord("n"), ord("i"), ord("g")); my $bytestring = pack("C*", @isochars); -my $utfstring = pack("U*", @isochars); +my $utfstring = pack("U*", @isochars); -Test(length($bytestring) == @isochars, 'Correct length for $bytestring'); -Test(length($utfstring) == @isochars, 'Correct length for $utfstring'); -Test(is_utf8($utfstring), +ok(length($bytestring) == @isochars, 'Correct length for $bytestring'); +ok(length($utfstring) == @isochars, 'Correct length for $utfstring'); +ok(is_utf8($utfstring), '$utfstring should be marked as UTF-8 by Perl'); -Test(! is_utf8($bytestring), +ok(! is_utf8($bytestring), '$bytestring should *NOT* be marked as UTF-8 by Perl'); ### Real DBD::SQLite testing starts here -my $dbh = DBI->connect('DBI:SQLite:dbname=foo', '', '', - {RaiseError => 1}) - or die <<'MESSAGE'; -Cannot connect to database 'DBI:SQLite:dbname=foo', please check directory and -permissions. -MESSAGE +my $dbh = connect_ok( RaiseError => 1 ); -eval { $dbh->do("DROP TABLE table1"); }; - -$dbh->do("CREATE TABLE table1 (a TEXT, b BLOB)"); +ok( + $dbh->do("CREATE TABLE table1 (a TEXT, b BLOB)"), + 'CREATE TABLE', +); # Sends $ain and $bin into TEXT resp. BLOB columns the database, then # reads them again and returns the result as a list ($aout, $bout). @@ -88,7 +63,6 @@ sub database_roundtrip { $sth->bind_param(1, $ain, SQL_VARCHAR); $sth->bind_param(2, $bin, SQL_BLOB); $sth->execute(); - $sth = $dbh->prepare("SELECT a, b FROM table1"); $sth->execute(); my @row = $sth->fetchrow_array; @@ -99,27 +73,25 @@ sub database_roundtrip { my ($textback, $bytesback) = database_roundtrip($bytestring, $bytestring); -Test(! is_utf8($bytesback), "Reading blob gives binary"); -Test(! is_utf8($textback), "Reading text gives binary too (for now)"); -Test($bytesback eq $bytestring, "No blob corruption"); -Test($textback eq $bytestring, "Same text, different encoding"); +ok(! is_utf8($bytesback), "Reading blob gives binary"); +ok(! is_utf8($textback), "Reading text gives binary too (for now)"); +ok($bytesback eq $bytestring, "No blob corruption"); +ok($textback eq $bytestring, "Same text, different encoding"); # Start over but now activate Unicode support. $dbh->{unicode} = 1; ($textback, $bytesback) = database_roundtrip($utfstring, $bytestring); -Test(! is_utf8($bytesback), "Reading blob still gives binary"); -Test(is_utf8($textback), "Reading text returns UTF-8"); -Test($bytesback eq $bytestring, "Still no blob corruption"); -Test($textback eq $utfstring, "Same text"); +ok(! is_utf8($bytesback), "Reading blob still gives binary"); +ok(is_utf8($textback), "Reading text returns UTF-8"); +ok($bytesback eq $bytestring, "Still no blob corruption"); +ok($textback eq $utfstring, "Same text"); my $lengths = $dbh->selectall_arrayref( "SELECT length(a), length(b) FROM table1" ); -Test($lengths->[0]->[0] == $lengths->[0]->[1], +ok($lengths->[0]->[0] == $lengths->[0]->[1], "Database actually understands char set") or warn "($lengths->[0]->[0] != $lengths->[0]->[1])"; - -$dbh->do("DROP TABLE table1"); diff --git a/t/lib/Test.pm b/t/lib/Test.pm index c53c600..18f92d5 100644 --- a/t/lib/Test.pm +++ b/t/lib/Test.pm @@ -9,7 +9,7 @@ use Test::More (); use vars qw{$VERSION @ISA @EXPORT}; BEGIN { - $VERSION = '1.19_09'; + $VERSION = '1.19_10'; @ISA = qw{ Exporter }; @EXPORT = qw{ connect_ok }; }