diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/cuirass/database.scm | 18 | ||||
-rw-r--r-- | src/cuirass/logging.scm | 17 |
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)))) |