Moved 12_unicode.t to Test::More

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

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

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');
+ok(length($bytestring) == @isochars, 'Correct length for $bytestring');
-Test(length($utfstring) == @isochars, 'Correct length for $utfstring');
+ok(length($utfstring) == @isochars, 'Correct length for $utfstring');
-Test(is_utf8($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', '', '',
+my $dbh = connect_ok( RaiseError => 1 );
-                       {RaiseError => 1})
-	or die <<'MESSAGE';
-Cannot connect to database 'DBI:SQLite:dbname=foo', please check directory and
-permissions.
-MESSAGE
 
-eval { $dbh->do("DROP TABLE table1"); };
+ok(
-
+	$dbh->do("CREATE TABLE table1 (a TEXT, b BLOB)"),
-$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");
+ok(! is_utf8($bytesback), "Reading blob gives binary");
-Test(! is_utf8($textback), "Reading text gives binary too (for now)");
+ok(! is_utf8($textback), "Reading text gives binary too (for now)");
-Test($bytesback eq $bytestring, "No blob corruption");
+ok($bytesback eq $bytestring, "No blob corruption");
-Test($textback eq $bytestring, "Same text, different encoding");
+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");
+ok(! is_utf8($bytesback), "Reading blob still gives binary");
-Test(is_utf8($textback), "Reading text returns UTF-8");
+ok(is_utf8($textback), "Reading text returns UTF-8");
-Test($bytesback eq $bytestring, "Still no blob corruption");
+ok($bytesback eq $bytestring, "Still no blob corruption");
-Test($textback eq $utfstring, "Same text");
+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");

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 };
 }