1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (include "common.scm")
;; (include "megatest-version.scm")
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos ) ;; (srfi 18) extras)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(use zmq)
|
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (include "common.scm")
;; (include "megatest-version.scm")
(define (toplevel-command . foo) #f)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos ) ;; (srfi 18) extras)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
(use zmq)
|
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(let ((transport (args:get-arg "-transport" "http")))
|
>
|
|
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
|
;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;; we start the server if not running else start the client thread
;;======================================================================
(if (args:get-arg "-server")
(let ((transport (or "zmq" ;; (config-lookup *configdat* "server" "transport")
(args:get-arg "-transport" "http"))))
(debug:print 2 "Launching server using transport " transport)
(server:launch (string->symbol transport))))
(if (args:get-arg "-list-servers")
;; (args:get-arg "-kill-server"))
(let ((tl (setup-for-run)))
(if tl
|