DBD-SQLite · charsbar · May 30, 2021 · May 30, 2021 · Jun 5, 2021
diff --git a/Changes b/Changes
@@ -1,5 +1,8 @@
 Changes for Perl extension DBD-SQLite
 
+1.67_05 to be released
+    - Made DBD_SQLITE_STRING_MODE constants exportable
+
 1.67_04 2021-05-31
     - Upgraded SQLite to 3.35.5
     - Stop setting THREADSAFE=0 if perl has pthread (ie. 5.20+)

diff --git 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
@@ -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
@@ -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
@@ -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/lib/DBD/SQLite/Constants.pm b/lib/DBD/SQLite/Constants.pm
@@ -319,6 +319,11 @@ our %EXPORT_TAGS = (
       SQLITE_DBCONFIG_TRIGGER_EQP
       SQLITE_DBCONFIG_TRUSTED_SCHEMA
       SQLITE_DBCONFIG_WRITABLE_SCHEMA
+      DBD_SQLITE_STRING_MODE_BYTES
+      DBD_SQLITE_STRING_MODE_PV
+      DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK
+      DBD_SQLITE_STRING_MODE_UNICODE_NAIVE
+      DBD_SQLITE_STRING_MODE_UNICODE_STRICT
       SQLITE_DELETE
       SQLITE_DENY
       SQLITE_DETACH
@@ -525,6 +530,14 @@ our %EXPORT_TAGS = (
       SQLITE_DBCONFIG_WRITABLE_SCHEMA
     /],
 
+    dbd_sqlite_string_mode => [qw/
+      DBD_SQLITE_STRING_MODE_BYTES
+      DBD_SQLITE_STRING_MODE_PV
+      DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK
+      DBD_SQLITE_STRING_MODE_UNICODE_NAIVE
+      DBD_SQLITE_STRING_MODE_UNICODE_STRICT
+    /],
+
     extended_result_codes => [qw/
       SQLITE_ABORT_ROLLBACK
       SQLITE_AUTH_USER
@@ -699,7 +712,7 @@ DBD::SQLite::Constants - common SQLite constants
 
 =head1 DESCRIPTION
 
-You can import necessary SQLite constants from this module. Available tags are C<all>, C<allowed_return_values_from_sqlite3_txn_state>, C<authorizer_action_codes>, C<authorizer_return_codes>, C<version> (C<compile_time_library_version_numbers>), C<database_connection_configuration_options>, C<extended_result_codes>, C<file_open> (C<flags_for_file_open_operations>), C<function_flags>, C<datatypes> (C<fundamental_datatypes>), C<result_codes>, C<run_time_limit_categories>. See L<http://sqlite.org/c3ref/constlist.html> for the complete list of constants.
+You can import necessary SQLite constants from this module. Available tags are C<all>, C<allowed_return_values_from_sqlite3_txn_state>, C<authorizer_action_codes>, C<authorizer_return_codes>, C<version> (C<compile_time_library_version_numbers>), C<database_connection_configuration_options>, C<dbd_sqlite_string_mode>, C<extended_result_codes>, C<file_open> (C<flags_for_file_open_operations>), C<function_flags>, C<datatypes> (C<fundamental_datatypes>), C<result_codes>, C<run_time_limit_categories>. See L<http://sqlite.org/c3ref/constlist.html> for the complete list of constants.
 
 This module does not export anything by default.
 
@@ -853,6 +866,22 @@ This module does not export anything by default.
 
 =back
 
+=head2 dbd_sqlite_string_mode
+
+=over 4
+
+=item DBD_SQLITE_STRING_MODE_PV
+
+=item DBD_SQLITE_STRING_MODE_BYTES
+
+=item DBD_SQLITE_STRING_MODE_UNICODE_NAIVE
+
+=item DBD_SQLITE_STRING_MODE_UNICODE_FALLBACK
+
+=item DBD_SQLITE_STRING_MODE_UNICODE_STRICT
+
+=back
+
 =head2 extended_result_codes
 
 =over 4

diff --git a/t/70_trace_sqlite3_log.t 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;
diff --git a/util/constants.pl b/util/constants.pl
@@ -189,11 +189,14 @@ END
 
   my %seen;
   $constants{all} = [sort grep {!$seen{$_}++} map {@$_} values %constants];
+  push @{$constants{all}}, @dbd_sqlite_constants;
+  $constants{dbd_sqlite_string_mode} = [grep /^DBD_SQLITE_STRING_MODE_/, @dbd_sqlite_constants];
 
+  my $sp = ' ' x 6;
   for my $tag (sort keys %constants) {
     print $fh <<"END";
     $tag => [qw/
-@{[join "\n", map {"      SQLITE_$_"} sort @{$constants{$tag}}]}
+@{[join "\n", map { /^DBD_SQLITE_/ ? "$sp$_" : "${sp}SQLITE_$_"} sort @{$constants{$tag}}]}
     /],
 
 END
@@ -244,10 +247,17 @@ END
 
 END
     for my $const (@{$constants{$tag}}) {
-      print $fh <<"END";
+      if ($const =~ /^DBD_SQLITE_/) {
+        print $fh <<"END";
+\=item $const
+
+END
+      } else {
+        print $fh <<"END";
 \=item SQLITE_$const
 
 END
+      }
     }
     print $fh <<"END";
 \=back