Added collations and progress

Changes

@@ -2,6 +2,9 @@ Revision history for Perl extension DBD-SQLite.
 
 1.19_04 not yet released
     - Updated to SQLite 3.6.12 (ISHIGAKI)
+    - Added collations from DBD::SQLite::Amalgamation (CORION)
+    . DBD::SQLite::Amalgamation 3.6.1.2 and DBD::SQLite 1.19_04
+      should be feature identical now.
 
 1.19_03 Tue 31 Mar 2009
     - Added ->column_info() (CORION)

SQLite.xs

@@ -54,6 +54,26 @@ create_aggregate(dbh, name, argc, aggr)
         sqlite3_db_create_aggregate( dbh, name, argc, aggr );
     }
 
+void
+create_collation(dbh, name, func)
+    SV *dbh
+    char *name
+    SV *func
+    CODE:
+    {
+        sqlite3_db_create_collation( dbh, name, func );
+    }
+
+void
+progress_handler(dbh, n_opcodes, handler)
+    SV *dbh
+    int n_opcodes
+    SV *handler
+    CODE:
+    {
+        sqlite3_db_progress_handler( dbh, n_opcodes, handler );
+    }
+
 int
 busy_timeout(dbh, timeout=0)
   SV *dbh

dbdimp.c

@@ -144,17 +144,12 @@ int
 sqlite_db_disconnect (SV *dbh, imp_dbh_t *imp_dbh)
 {
     dTHR;
-    sqlite3_stmt *pStmt;
     DBIc_ACTIVE_off(imp_dbh);
 
     if (DBIc_is(imp_dbh, DBIcf_AutoCommit) == FALSE) {
         sqlite_db_rollback(dbh, imp_dbh);
     }
 
-    while ( (pStmt = sqlite3_next_stmt(imp_dbh->db, 0))!=0 ) {
-        sqlite3_finalize(pStmt);
-    }
-
     if (sqlite3_close(imp_dbh->db) == SQLITE_BUSY) {
         /* active statements! */
         warn("closing dbh with active statement handles");
@@ -162,11 +157,9 @@ sqlite_db_disconnect (SV *dbh, imp_dbh_t *imp_dbh)
     imp_dbh->db = NULL;
 
     av_undef(imp_dbh->functions);
-    SvREFCNT_dec(imp_dbh->functions);
     imp_dbh->functions = (AV *)NULL;
 
     av_undef(imp_dbh->aggregates);
-    SvREFCNT_dec(imp_dbh->aggregates);
     imp_dbh->aggregates = (AV *)NULL;
 
     return TRUE;
@@ -405,7 +398,8 @@ sqlite_st_execute (SV *sth, imp_sth_t *imp_sth)
             if (imp_sth->retval == SQLITE_ROW) {
                 continue;
             }
-            sqlite3_reset(imp_sth->stmt);
+            /* There are bug reports that say this should be sqlite3_reset() */
+            sqlite3_finalize(imp_sth->stmt);
             sqlite_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, (char*)sqlite3_errmsg(imp_dbh->db));
             return -5;
         }
@@ -612,13 +606,9 @@ sqlite_st_finish3 (SV *sth, imp_sth_t *imp_sth, int is_destroy)
 void
 sqlite_st_destroy (SV *sth, imp_sth_t *imp_sth)
 {
-    D_imp_dbh_from_sth;
     /* warn("destroy statement: %s\n", imp_sth->statement); */
     DBIc_ACTIVE_off(imp_sth);
-    if (DBIc_ACTIVE(imp_dbh)) {
+    sqlite3_finalize(imp_sth->stmt);
-        /* finalize sth when active connection */
-        sqlite3_finalize(imp_sth->stmt);
-    }
     Safefree(imp_sth->statement);
     SvREFCNT_dec((SV*)imp_sth->params);
     SvREFCNT_dec((SV*)imp_sth->col_types);
@@ -1102,4 +1092,149 @@ sqlite3_db_create_aggregate( SV *dbh, const char *name, int argc, SV *aggr_pkg )
     }
 }
 
+
+int sqlite_db_collation_dispatcher(void *func, int len1, const void *string1,
+                                               int len2, const void *string2)
+{
+    dSP;
+    int cmp;
+    int n_retval;
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    XPUSHs( sv_2mortal ( newSVpvn( string1, len1) ) );
+    XPUSHs( sv_2mortal ( newSVpvn( string2, len2) ) );
+    PUTBACK;
+    n_retval = call_sv((void*)func, G_SCALAR);
+    if (n_retval != 1) {
+      croak("collation function returned %d arguments", n_retval);
+    }
+    SPAGAIN;
+    cmp = POPi;
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+
+    return cmp;
+}
+
+int sqlite_db_collation_dispatcher_utf8(
+  void *func, int len1, const void *string1,
+              int len2, const void *string2)
+{
+    dSP;
+    int cmp;
+    int n_retval;
+    SV *sv1, *sv2;
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    sv1 = newSVpvn( string1, len1);
+    SvUTF8_on(sv1);
+    sv2 = newSVpvn( string2, len2);
+    SvUTF8_on(sv2);
+    XPUSHs( sv_2mortal ( sv1 ) );
+    XPUSHs( sv_2mortal ( sv2 ) );
+    PUTBACK;
+    n_retval = call_sv((void*)func, G_SCALAR);
+    if (n_retval != 1) {
+      croak("collation function returned %d arguments", n_retval);
+    }
+    SPAGAIN;
+    cmp = POPi;
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+
+    return cmp;
+}
+
+
+void
+sqlite3_db_create_collation( SV *dbh, const char *name, SV *func )
+{
+    D_imp_dbh(dbh);
+    int rv, rv2;
+    void *aa = "aa";
+    void *zz = "zz";
+
+    SV *func_sv = newSVsv(func);
+
+    /* Check that this is a proper collation function */
+    rv = sqlite_db_collation_dispatcher(func_sv, 2, aa, 2, aa);
+    if (rv != 0) {
+      warn("improper collation function: %s(aa, aa) returns %d!", name, rv); 
+    }
+    rv  = sqlite_db_collation_dispatcher(func_sv, 2, aa, 2, zz);
+    rv2 = sqlite_db_collation_dispatcher(func_sv, 2, zz, 2, aa);
+    if (rv2 != (rv * -1)) {
+      warn("improper collation function: '%s' is not symmetric", name); 
+    }
+
+    /* Copy the func reference so that it can be deallocated at disconnect */
+    av_push( imp_dbh->functions, func_sv );
+
+    /* Register the func within sqlite3 */
+    rv = sqlite3_create_collation( 
+      imp_dbh->db, name, SQLITE_UTF8,
+      func_sv, 
+      imp_dbh->unicode ? sqlite_db_collation_dispatcher_utf8 
+                       : sqlite_db_collation_dispatcher
+      );
+
+    if ( rv != SQLITE_OK )
+    {
+        croak( "sqlite_create_collation failed with error %s", 
+               sqlite3_errmsg(imp_dbh->db) );
+    }
+}
+
+
+int sqlite_db_progress_handler_dispatcher( void *handler )
+{
+    dSP;
+    int n_retval;
+    int retval;
+
+    PUSHMARK(SP);
+    n_retval = call_sv( handler, G_SCALAR );
+    if ( n_retval != 1 ) {
+      croak( "progress_handler returned %d arguments", n_retval );
+    }
+    SPAGAIN;
+    retval = POPi;
+    PUTBACK;
+
+    return retval;
+}
+
+
+
+void
+sqlite3_db_progress_handler( SV *dbh, int n_opcodes, SV *handler )
+{
+    D_imp_dbh(dbh);
+
+    if (handler == &PL_sv_undef) {
+      /* remove previous handler */
+      sqlite3_progress_handler( imp_dbh->db, 0, NULL, NULL);
+    }
+    else {
+      int rv;
+      SV *handler_sv = newSVsv(handler);
+
+      /* Copy the handler ref so that it can be deallocated at disconnect */
+      av_push( imp_dbh->functions, handler_sv );
+
+      /* Register the func within sqlite3 */
+      sqlite3_progress_handler( imp_dbh->db, n_opcodes, 
+                                sqlite_db_progress_handler_dispatcher,
+                                handler_sv );
+    }
+}
+
+
+
 /* end */

dbdimp.h

@@ -76,6 +76,8 @@ struct imp_sth_st {
 
 void sqlite3_db_create_function(SV *dbh, const char *name, int argc, SV *func);
 void sqlite3_db_create_aggregate( SV *dbh, const char *name, int argc, SV *aggr );
+void sqlite_db_create_collation(SV *dbh, const char *name, SV *func);
+void sqlite_db_progress_handler(SV *dbh, int n_opcodes, SV *handler);
 void sqlite_st_reset( SV *sth );
 int sqlite_bind_col( SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV sql_type, SV *attribs );
 int dbd_set_sqlite3_busy_timeout ( SV *dbh, int timeout );

lib/DBD/SQLite.pm

@@ -60,6 +60,12 @@ sub connect {
     DBD::SQLite::db::_login($dbh, $real_dbname, $user, $auth)
         or return undef;
 
+    # install perl collations
+    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" );
+
     return $dbh;
 }
 

t/12create_collation.t

@@ -0,0 +1,89 @@
+BEGIN { 
+    local $@;
+    unless (eval { require Test::More; require Encode; 1 }) {
+        print "1..0 # Skip need Perl 5.8 or later\n";
+        exit;
+    }
+}
+
+use Test::More tests => 8;
+use DBI;
+use Encode qw/decode/;
+
+
+
+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/;
+
+# my @words_utf8 = map {decode("iso-8859-1", $_)} @words;
+@words_utf8 = @words;
+utf8::upgrade($_) foreach @words_utf8;
+
+
+$" = ", "; # to embed arrays into message strings
+
+my $dbh;
+my @sorted;
+my $db_sorted;
+my $sql = "SELECT txt from collate_test ORDER BY txt";
+
+sub no_accents ($$) {
+    my ( $a, $b ) = map lc, @_;
+
+    tr[àâáäåãçðèêéëìîíïñòôóöõøùûúüý]
+      [aaaaaacdeeeeiiiinoooooouuuuy] for $a, $b;
+
+    $a cmp $b;
+}
+
+
+
+$dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { RaiseError => 1 } );
+ok($dbh);
+
+$dbh->func( "no_accents", \&no_accents, "create_collation" );
+
+$dbh->do( 'CREATE TEMP TABLE collate_test ( txt )' );
+$dbh->do( "INSERT INTO collate_test VALUES ( '$_' )" ) foreach @words;
+
+
+@sorted    = sort @words;
+$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perl");
+is_deeply(\@sorted, $db_sorted, "collate perl (@sorted // @$db_sorted)");
+
+{use locale; @sorted    = sort @words;}
+$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perllocale");
+is_deeply(\@sorted, $db_sorted, "collate perllocale (@sorted // @$db_sorted)");
+
+@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)");
+$dbh->disconnect;
+
+
+$dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", 
+                    { RaiseError => 1,
+                      unicode    => 1} );
+ok($dbh);
+$dbh->func( "no_accents", \&no_accents, "create_collation" );
+$dbh->do( 'CREATE TEMP TABLE collate_test ( txt )' );
+$dbh->do( "INSERT INTO collate_test VALUES ( '$_' )" ) foreach @words_utf8;
+
+@sorted    = sort @words_utf8;
+$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perl");
+is_deeply(\@sorted, $db_sorted, "collate perl (@sorted // @$db_sorted)");
+
+{use locale; @sorted    = sort @words_utf8;}
+$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE perllocale");
+is_deeply(\@sorted, $db_sorted, "collate perllocale (@sorted // @$db_sorted)");
+
+@sorted    = sort no_accents @words_utf8;
+$db_sorted = $dbh->selectcol_arrayref("$sql COLLATE no_accents");
+is_deeply(\@sorted, $db_sorted, "collate no_accents (@sorted // @$db_sorted)");
+
+
+
+$dbh->disconnect;

t/13progress_handler.t

@@ -0,0 +1,43 @@
+use Test;
+BEGIN { plan tests => 3; }
+use DBI;
+
+my $N_OPCODES = 50; # how many opcodes before calling the progress handler
+
+# our progress_handler just remembers how many times it was called
+my $n_callback = 0;
+sub progress_handler {
+  $n_callback += 1;
+  return 0;
+}
+
+# connect and register the progress handler
+my $dbh = DBI->connect("dbi:SQLite:dbname=foo", "", "", { RaiseError => 1 } );
+ok($dbh);
+$dbh->func( $N_OPCODES, \&progress_handler, "progress_handler" );
+
+# populate a temporary table with random numbers
+$dbh->do( 'CREATE TEMP TABLE progress_test ( foo )' );
+$dbh->begin_work;
+for my $count (1 .. 1000) {
+  my $rand = rand;
+  $dbh->do( "INSERT INTO progress_test(foo) VALUES ( $rand )" );
+}
+$dbh->commit;
+
+# let the DB do some work (sorting the random numbers)
+my $result = $dbh->do( "SELECT * from progress_test ORDER BY foo  " );
+
+# now the progress handler should have been called a number of times
+ok($n_callback);
+
+
+# unregister the progress handler, set counter back to zero, do more work
+$dbh->func( $N_OPCODES, undef, "progress_handler" );
+$n_callback = 0;
+$result = $dbh->do( "SELECT * from progress_test ORDER BY foo DESC " );
+
+# now the progress handler should have been called zero times
+ok(!$n_callback);
+
+$dbh->disconnect;