From dddc12423a46e4383a00ca9dcb93c999f4ad0062 Mon Sep 17 00:00:00 2001 From: Kenichi Ishigaki Date: Mon, 31 May 2021 08:31:22 +0900 Subject: [PATCH 1/3] Make DBD_SQLITE_STRING_MODE_ constants exportable --- lib/DBD/SQLite/Constants.pm | 31 ++++++++++++++++++++++++++++++- util/constants.pl | 14 ++++++++++++-- 2 files changed, 42 insertions(+), 3 deletions(-) diff --git a/lib/DBD/SQLite/Constants.pm b/lib/DBD/SQLite/Constants.pm index fbf7763..b2bd2f0 100644 --- 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, C, C, C, C (C), C, C, C (C), C, C (C), C, C. See L for the complete list of constants. +You can import necessary SQLite constants from this module. Available tags are C, C, C, C, C (C), C, C, C, C (C), C, C (C), C, C. See L 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/util/constants.pl b/util/constants.pl index b2ac327..ea2d2a5 100644 --- 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 From 9e59c780a775aecac2fb219d4aa66f7a9e9a49ab Mon Sep 17 00:00:00 2001 From: Kenichi Ishigaki Date: Mon, 31 May 2021 08:33:58 +0900 Subject: [PATCH 2/3] Update Changes --- Changes | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Changes b/Changes index c95e15c..68288f9 100644 --- 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+) From bfa8ea6571deab2ba47598579c364675e3cff904 Mon Sep 17 00:00:00 2001 From: Kenichi Ishigaki Date: Sun, 6 Jun 2021 01:12:53 +0900 Subject: [PATCH 3/3] Add experimental trace_sqlite3_log --- SQLite.xs | 14 ++++++++++++++ dbdimp.c | 36 ++++++++++++++++++++++++++++++++++++ dbdimp.h | 2 ++ lib/DBD/SQLite.pm | 5 +++++ t/70_trace_sqlite3_log.t | 35 +++++++++++++++++++++++++++++++++++ 5 files changed, 92 insertions(+) create mode 100644 t/70_trace_sqlite3_log.t 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;