diff --git a/SQLite.xs b/SQLite.xs index 48f113d..d5a78bc 100644 --- a/SQLite.xs +++ b/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 diff --git a/dbdimp.c b/dbdimp.c index c81b6f7..cf21c35 100644 --- a/dbdimp.c +++ b/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 ) { diff --git a/dbdimp.h b/dbdimp.h index b357e1f..598b619 100644 --- a/dbdimp.h +++ b/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 diff --git a/lib/DBD/SQLite.pm b/lib/DBD/SQLite.pm index f76f3b2..7cc68ca 100644 --- a/lib/DBD/SQLite.pm +++ b/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; diff --git a/t/70_trace_sqlite3_log.t b/t/70_trace_sqlite3_log.t new file mode 100644 index 0000000..244e620 --- /dev/null +++ b/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;