158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database at " dbfname " probably overloaded or unreadable. Try removing it.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print "exn=" (condition->list exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(print-call-chain (current-error-port)))
(cond
((> numargs 1) ;; most commands
(case (string->symbol (car args)) ;; commands with two or more params
((take)(portlogger:take-port db (string->number (cadr args))))
((set) (portlogger:set-port db
(string->number (cadr args))
(caddr args))
(caddr args))
((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed)))))))
(sqlite3:finalize! db)
result))
;; (print (apply portlogger:main (cdr (argv))))
|
|
<
<
>
|
|
>
>
>
|
|
|
|
|
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
|
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: portlogger database at " dbfname " probably overloaded or unreadable. Try removing it.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print "exn=" (condition->list exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(print-call-chain (current-error-port))
#f)
(case (string->symbol (car args)) ;; commands with two or more params
((take)(portlogger:take-port db (string->number (cadr args))))
((find)(portlogger:find-port db))
((set) (let ((port (cadr args))
(state (caddr args)))
(portlogger:set-port db
(if (number? port) port (string->number port))
state)
state))
((failed)(portlogger:set-failed db (string->number (cadr args))) 'failed)))))
(sqlite3:finalize! db)
result))
;; (print (apply portlogger:main (cdr (argv))))
|