Working on aging links

1 files changed, 4 insertions, 4 deletions

diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm
index 0d7cd40..223b5fd 100644
--- a/gn/db/mysql.scm
+++ b/gn/db/mysql.scm
@@ -32,23 +32,23 @@
     ;; (display "===> OPENING DB")
     ;; (newline)
     (let [(db (dbi-open "mysql" "webqtlout:webqtlout:db_webqtl:tcp:127.0.0.1:3306"))]
-      (ensure db)
+      (ensure db "Can't open connection")
       db
     )))
 
 (define (call-with-db thunk)
   (thunk (db-open)))
 
-(define (ensure db)
+(define (ensure db msg1)
   "Use DBI-style handle to report an error. On error the program will stop."
   (match (dbi-get_status db)
     ((stat . msg) (if (= stat 0)
                      #t
                      (begin
                        (display "SQL Connection ERROR! ")
-                       (display msg)
+                       (display (string-append msg1 " - " msg)
                        (newline)
-                       (assert stat))))))
+                       (assert #f)))))))
 
 (define (has-result? db)
   "Return #t or #f if result is valid"