sqlite_trace/sqlite_profile

Changes

@@ -6,6 +6,9 @@ Changes for Perl extension DBD-SQLite
     - Resolved #73159: FTS tokenizer segfault (ISHIGAKI)
     - Resolved #73787: sqlite_see_if_its_a_number causes a buffer
       overflow (ISHIGAKI)
+    - Implemented sqlite_trace and sqlite_profile methods for simpler
+      tracing/profiling; use DBI_TRACE/DBI_PROFILE for more
+      complicated cases (ISHIGAKI)
 
 1.35 Tue 29 Nov 2011
     - Updated to SQLite 3.7.9 (ISHIGAKI)

SQLite.xs

@@ -113,6 +113,32 @@ progress_handler(dbh, n_opcodes, handler)
     OUTPUT:
         RETVAL
 
+static int
+trace(dbh, callback)
+    SV *dbh
+    SV *callback
+    ALIAS:
+        DBD::SQLite::db::sqlite_trace = 1
+    CODE:
+    {
+        RETVAL = sqlite_db_trace(aTHX_ dbh, callback );
+    }
+    OUTPUT:
+        RETVAL
+
+static int
+profile(dbh, callback)
+    SV *dbh
+    SV *callback
+    ALIAS:
+        DBD::SQLite::db::sqlite_profile = 1
+    CODE:
+    {
+        RETVAL = sqlite_db_profile(aTHX_ dbh, callback );
+    }
+    OUTPUT:
+        RETVAL
+
 SV*
 commit_hook(dbh, hook)
     SV *dbh

dbdimp.c

@@ -1993,6 +1993,130 @@ sqlite_db_set_authorizer(pTHX_ SV *dbh, SV *authorizer)
     return retval;
 }
 
+#ifndef SQLITE_OMIT_TRACE
+void
+sqlite_db_trace_dispatcher(void *callback, const char *sql)
+{
+    dTHX;
+    dSP;
+    int n_retval, i;
+    int retval = 0;
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    XPUSHs( sv_2mortal( newSVpv( sql, 0 ) ) );
+    PUTBACK;
+
+    n_retval = call_sv( callback, G_SCALAR );
+    SPAGAIN;
+    if ( n_retval != 1 ) {
+        warn( "callback returned %d arguments", n_retval );
+    }
+    for(i = 0; i < n_retval; i++) {
+        retval = POPi;
+    }
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+}
+
+int
+sqlite_db_trace(pTHX_ SV *dbh, SV *func)
+{
+    D_imp_dbh(dbh);
+
+    if (!DBIc_ACTIVE(imp_dbh)) {
+        sqlite_error(dbh, -2, "attempt to set trace on inactive database handle");
+        return FALSE;
+    }
+
+    croak_if_db_is_null();
+
+    if (!SvOK(func)) {
+        /* remove previous callback */
+        sqlite3_trace( imp_dbh->db, NULL, NULL );
+    }
+    else {
+        SV *func_sv = newSVsv(func);
+
+        /* Copy the func ref so that it can be deallocated at disconnect */
+        av_push( imp_dbh->functions, func_sv );
+
+        /* Register the func within sqlite3 */
+        sqlite3_trace( imp_dbh->db,
+                       sqlite_db_trace_dispatcher,
+                       func_sv );
+    }
+    return TRUE;
+}
+#endif
+
+void
+sqlite_db_profile_dispatcher(void *callback, const char *sql, sqlite3_uint64 elapsed)
+{
+    dTHX;
+    dSP;
+    int n_retval, i;
+    int retval = 0;
+
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    XPUSHs( sv_2mortal( newSVpv( sql, 0 ) ) );
+    /*
+     * The profile callback time is in units of nanoseconds,
+     * however the current implementation is only capable of
+     * millisecond resolution so the six least significant digits
+     * in the time are meaningless.
+     * (http://sqlite.org/c3ref/profile.html)
+     */
+    XPUSHs( sv_2mortal( newSViv( elapsed / 1000000 ) ) );
+    PUTBACK;
+
+    n_retval = call_sv( callback, G_SCALAR );
+    SPAGAIN;
+    if ( n_retval != 1 ) {
+        warn( "callback returned %d arguments", n_retval );
+    }
+    for(i = 0; i < n_retval; i++) {
+        retval = POPi;
+    }
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+}
+
+int
+sqlite_db_profile(pTHX_ SV *dbh, SV *func)
+{
+    D_imp_dbh(dbh);
+
+    if (!DBIc_ACTIVE(imp_dbh)) {
+        sqlite_error(dbh, -2, "attempt to profile on inactive database handle");
+        return FALSE;
+    }
+
+    croak_if_db_is_null();
+
+    if (!SvOK(func)) {
+        /* remove previous callback */
+        sqlite3_profile( imp_dbh->db, NULL, NULL );
+    }
+    else {
+        SV *func_sv = newSVsv(func);
+
+        /* Copy the func ref so that it can be deallocated at disconnect */
+        av_push( imp_dbh->functions, func_sv );
+
+        /* Register the func within sqlite3 */
+        sqlite3_profile( imp_dbh->db,
+                         sqlite_db_profile_dispatcher,
+                         func_sv );
+    }
+    return TRUE;
+}
+
 /* Accesses the SQLite Online Backup API, and fills the currently loaded
  * database from the passed filename.
  * Usual usage of this would be when you're operating on the :memory:

lib/DBD/SQLite.pm

@@ -56,6 +56,8 @@ sub driver {
         DBD::SQLite::db->install_method('sqlite_backup_to_file');
         DBD::SQLite::db->install_method('sqlite_enable_load_extension');
         DBD::SQLite::db->install_method('sqlite_register_fts3_perl_tokenizer');
+        DBD::SQLite::db->install_method('sqlite_trace');
+        DBD::SQLite::db->install_method('sqlite_profile');
 
         $methods_are_installed++;
     }
@@ -1522,6 +1524,59 @@ sqlite3 extensions. After the call, you can load extensions like this:
   $sth = $dbh->prepare("select load_extension('libsqlitefunctions.so')")
   or die "Cannot prepare: " . $dbh->errstr();
 
+=head2 $dbh->sqlite_trace( $code_ref )
+
+This method registers a trace callback to be invoked whenever
+SQL statements are being run.
+
+The callback will be called as
+
+  $code_ref->($statement)
+
+where
+
+=over
+
+=item $statement
+
+is a UTF-8 rendering of the SQL statement text as the statement
+first begins executing.
+
+=back
+
+Additional callbacks might occur as each triggered subprogram is
+entered. The callbacks for triggers contain a UTF-8 SQL comment
+that identifies the trigger.
+
+See also L<DBI/TRACING> for better tracing options.
+
+=head2 $dbh->sqlite_profile( $code_ref )
+
+This method registers a profile callback to be invoked whenever
+a SQL statement finishes.
+
+The callback will be called as
+
+  $code_ref->($statement, $elapsed_time)
+
+where
+
+=over
+
+=item $statement
+
+is the original statement text (without bind parameters).
+
+=item $elapsed_time
+
+is an estimate of wall-clock time of how long that statement took to run (in milliseconds).
+
+=back
+
+This method is considered experimental and is subject to change in future versions of SQLite.
+
+See also L<DBI::Profile> for better profiling options.
+
 =head2 DBD::SQLite::compile_options()
 
 Returns an array of compile options (available since sqlite 3.6.23,

t/49_trace_and_profile.t

@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+	$|  = 1;
+	$^W = 1;
+}
+
+use t::lib::Test qw/connect_ok/;
+use Test::More tests => 13;
+use Test::NoWarnings;
+
+my $dbh = connect_ok();
+
+{ # trace
+	my @trace;
+	$dbh->sqlite_trace(sub { push @trace, [@_] });
+	$dbh->do('create table foo (id integer)');
+	is $trace[0][0] => "create table foo (id integer)";
+
+	$dbh->do('insert into foo values (?)', undef, 1);
+	is $trace[1][0] => "insert into foo values ('1')";
+
+	$dbh->sqlite_trace(undef);
+
+	$dbh->do('insert into foo values (?)', undef, 2);
+	is @trace => 2;
+
+	$dbh->sqlite_trace(sub { push @trace, [@_] });
+	$dbh->do('insert into foo values (?)', undef, 3);
+	is $trace[2][0] => "insert into foo values ('3')";
+}
+
+{ # profile
+	my @profile;
+	$dbh->sqlite_profile(sub { push @profile, [@_] });
+	$dbh->do('create table bar (id integer)');
+	is $profile[0][0] => "create table bar (id integer)";
+	like $profile[0][1] => qr/^[0-9]+$/;
+
+	$dbh->do('insert into bar values (?)', undef, 1);
+	is $profile[1][0] => "insert into bar values (?)";
+	like $profile[1][1] => qr/^[0-9]+$/;
+
+	$dbh->sqlite_profile(undef);
+
+	$dbh->do('insert into bar values (?)', undef, 2);
+	is @profile => 2;
+
+	$dbh->sqlite_profile(sub { push @profile, [@_] });
+	$dbh->do('insert into bar values (?)', undef, 3);
+	is $profile[2][0] => "insert into bar values (?)";
+	like $profile[2][1] => qr/^[0-9]+$/;
+}