Add SQL query logging support.

* bin/cuirass.in (show-help): Document "--log-queries" option.
(%options): Add it.
(main): Enable query logging if the above option is set.
* src/cuirass/database.scm (db-log-queries): New procedure.
* src/cuirass/logging.scm (query-logging-port): New parameter.
(log-query): New procedure.

2 files changed, 34 insertions, 1 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 8cc9376..666a20b 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -34,12 +34,15 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
   #:use-module (sqlite3)
   #:export (;; Procedures.
             db-init
             db-open
             db-close
             db-optimize
+            db-log-queries
             db-add-specification
             db-remove-specification
             db-get-specification
@@ -303,6 +306,21 @@ database object."
     (sqlite-exec db "PRAGMA wal_checkpoint(TRUNCATE);")
     (db-close db)))
 
+(define (trace-callback trace p x)
+  (log-query (pointer->string
+              (sqlite-expanded-sql p))
+             (make-time 'time-duration
+                        (bytevector-uint-ref
+                         (pointer->bytevector x (sizeof uint64))
+                         0 (native-endianness)
+                         (sizeof uint64))
+                        0)))
+
+(define (db-log-queries file)
+  (with-db-worker-thread db
+    (query-logging-port (open-output-file file))
+    (sqlite-trace db SQLITE_TRACE_PROFILE trace-callback)))
+
 (define (last-insert-rowid db)
   (vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();"))
               0))
diff --git a/src/cuirass/logging.scm b/src/cuirass/logging.scm
index 6258eed..97eb6f7 100644
--- a/src/cuirass/logging.scm
+++ b/src/cuirass/logging.scm
@@ -25,7 +25,9 @@
             current-logging-procedure
             log-message
             with-time-logging
-            log-monitoring-stats))
+            log-monitoring-stats
+            query-logging-port
+            log-query))
 
 (define current-logging-port
   (make-parameter (current-error-port)))
@@ -77,3 +79,16 @@
                              (lambda (file)
                                (not (member file '("." "..")))))
                     '()))))
+
+(define query-logging-port
+  (make-parameter #f))
+
+(define (log-query query time)
+  (format (query-logging-port) "~a ~,2f~%"
+          (string-join
+           (string-tokenize query
+                            (char-set-complement
+                             (char-set #\space #\newline #\;)))
+           " ")
+          (+ (time-second time)
+             (/ (time-nanosecond time) 1e9))))