aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/cuirass/database.scm18
-rw-r--r--src/cuirass/logging.scm17
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))))