48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+
-
+
-
|
fail_count INTEGER DEFAULT 0,
update_time TIMESTAMP DEFAULT (strftime('%s','now')) );")
db))
(define (portlogger:open-run-close proc . params)
(let* ((fname (conc "/tmp/." (current-user-name) "-portlogger.db"))
(avail (tasks:wait-on-journal fname 10))) ;; wait up to about 10 seconds for the journal to go away
;;(handle-exceptions
;; exn
;; (begin
;; ;; (release-dot-lock fname)
;; (debug:print-error 0 *default-log-port* "portlogger:open-run-close failed. " proc " " params)
;; (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
;; (debug:print 0 *default-log-port* "exn=" (condition->list exn))
;; (if (file-exists? fname)
(handle-exceptions
exn
(begin
;; (release-dot-lock fname)
(debug:print-error 0 *default-log-port* "portlogger:open-run-close failed. " proc " " params)
(debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 *default-log-port* "exn=" (condition->list exn))
(if (file-exists? fname)(delete-file fname)) ;; brutally get rid of it
;; (begin
;; (debug:print 0 *default-log-port* "Removing portlogger database file " fname)
;; (delete-file fname))) ;; just get rid of the portlogger file
;; (print-call-chain (current-error-port)))
res)))
res))))
;; )
|