Add experimental trace_sqlite3_log

SQLite.xs

@@ -406,6 +406,20 @@ st_status(sth, reset = 0)
     OUTPUT:
         RETVAL
 
+MODULE = DBD::SQLite          PACKAGE = DBD::SQLite::dr
+
+int
+trace_sqlite3_log(drh, flag = 1)
+    SV *drh
+    int flag
+    ALIAS:
+        DBD::SQLite::dr::sqlite_trace_sqlite3_log = 1
+    CODE:
+        RETVAL = sqlite_trace_sqlite3_log(aTHX_ drh, flag);
+    OUTPUT:
+        RETVAL
+
+
 MODULE = DBD::SQLite          PACKAGE = DBD::SQLite
 
 # a couple of constants exported from sqlite3.h

dbdimp.c

@@ -161,6 +161,25 @@ _sqlite_error(pTHX_ char *file, int line, SV *h, int rc, const char *what)
     }
 }
 
+static void
+_sqlite_log_callback(void *unused, int error_code, const char *message)
+{
+    dTHX;
+
+    SV* drh = get_sv("DBD::SQLite::drh", 0);
+
+    if (drh && SvOK(drh)) {
+        D_imp_drh(drh);
+
+        if ( DBIc_TRACE_LEVEL(imp_drh) >= 3 ) {
+            PerlIO_printf(
+                DBIc_LOGPIO(imp_drh),
+                "sqlite3_log (%d) %s\n", error_code, message
+            );
+        }
+    }
+}
+
 int
 _sqlite_exec(pTHX_ SV *h, sqlite3 *db, const char *sql)
 {
@@ -1726,6 +1745,23 @@ sqlite_db_filename(pTHX_ SV *dbh)
     return filename ? newSVpv(filename, 0) : &PL_sv_undef;
 }
 
+int
+sqlite_trace_sqlite3_log(pTHX_ SV *drh, int flag)
+{
+    int rc = 0;
+#if SQLITE_VERSION_NUMBER >= 3006023
+    rc = sqlite3_config(SQLITE_CONFIG_LOG, flag ? _sqlite_log_callback : NULL, NULL);
+    if (rc == SQLITE_OK) {
+        return 1;
+    } else {
+        sqlite_error(drh, rc, "trace_sqlite3_log must be called before sqlite3 is initialized");
+        return 0;
+    }
+#else
+    return 0;
+#endif
+}
+
 int
 sqlite_db_busy_timeout(pTHX_ SV *dbh, SV *timeout )
 {

dbdimp.h

@@ -176,6 +176,7 @@ SV* sqlite_db_rollback_hook( pTHX_ SV *dbh, SV *hook );
 SV* sqlite_db_update_hook( pTHX_ SV *dbh, SV *hook );
 int sqlite_db_set_authorizer( pTHX_ SV *dbh, SV *authorizer );
 AV* sqlite_compile_options();
+int sqlite_trace_sqlite3_log(pTHX_ SV *drh, int flag);
 int sqlite_db_trace(pTHX_ SV *dbh, SV *func);
 int sqlite_db_profile(pTHX_ SV *dbh, SV *func);
 HV* sqlite_db_table_column_metadata(pTHX_ SV *dbh, SV *dbname, SV *tablename, SV *columnname);
@@ -191,6 +192,7 @@ int sqlite_db_get_autocommit(pTHX_ SV *dbh);
 int sqlite_db_txn_state(pTHX_ SV *dbh, SV *schema);
 int sqlite_db_do_sv(SV *dbh, imp_dbh_t *imp_dbh, SV *sv_statement);
 void init_cxt();
+static void _sqlite_log_callback(void *unused, int error_code, const char *message);
 
 
 #ifdef SvUTF8_on

lib/DBD/SQLite.pm

@@ -62,6 +62,7 @@ sub driver {
         DBD::SQLite::db->install_method('sqlite_db_config');
         DBD::SQLite::db->install_method('sqlite_get_autocommit');
         DBD::SQLite::db->install_method('sqlite_txn_state');
+        DBD::SQLite::dr->install_method('sqlite_trace_sqlite3_log');
 
         $methods_are_installed++;
     }
@@ -79,6 +80,10 @@ sub CLONE {
     undef $drh;
 }
 
+sub trace_sqlite3_log {
+    shift if $_[0] && $_[0] eq 'DBD::SQLite';
+    driver('DBD::SQLite')->sqlite_trace_sqlite3_log(@_);
+}
 
 package # hide from PAUSE
     DBD::SQLite::dr;

t/70_trace_sqlite3_log.t

@@ -0,0 +1,35 @@
+use strict;
+use warnings;
+use lib "t/lib";
+use SQLiteTest qw/connect_ok requires_sqlite/;
+use Test::More;
+use if -d ".git", "Test::FailWarnings";
+
+BEGIN { requires_sqlite('3.6.23') }
+
+require DBD::SQLite;
+my $res = DBD::SQLite->trace_sqlite3_log(1);
+ok $res, "got $res" or note(DBI->errstr);
+
+open my $trace_fh, '>', \my $trace_string;
+
+DBI->trace(3, $trace_fh);
+
+my $dbh = connect_ok(PrintError => 0, RaiseError => 1);
+
+eval {
+    $dbh->selectrow_array(q{ SELECT FROM FROM });
+};
+
+like $trace_string, qr/sqlite3_log \(\d+\)/,
+    'sqlite3_log messages forwarded to DBI tracing mechanism';
+
+note $trace_string;
+
+#$dbh->disconnect;
+#undef $dbh;
+
+#my $res = DBD::SQLite->trace_sqlite3_log(0);
+#ok $res, "got $res" or note(DBI->errstr);
+
+done_testing;