Megatest

Diff
Login

Differences From Artifact [794fa31626]:

To Artifact [7e3a6d5914]:


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
;;======================================================================
;; 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.
;;======================================================================

(use srfi-1 data-structures posix regex-case base64 format dot-locking csv-xml z3 sql-de-lite hostinfo md5 message-digest typed-records directory-utils stack
     matchable)
(require-extension regex posix)

(require-extension (srfi 18) extras tcp rpc)

(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))


(declare (unit common))

(include "common_records.scm")

;; (require-library margs)
;; (include "margs.scm")











|
|
<
|
|
|
|
<
>







1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17

18
19
20
21
22
23
24
25
;;======================================================================
;; 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.
;;======================================================================

(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 ;; sql-de-lite

     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)

     )

(declare (unit common))

(include "common_records.scm")

;; (require-library margs)
;; (include "margs.scm")
2269
2270
2271
2272
2273
2274
2275
2276








































2277
2278
2279
2280
2281
2282
2283
				    fallback-launcher
				    (loop (car tal)(cdr tal)))))))
		      ;; no match, try again
		      (if (null? tal)
			  fallback-launcher
			  (loop (car tal)(cdr tal))))))))
	fallback-launcher)))
  








































;;======================================================================
;; D A S H B O A R D   U S E R   V I E W S
;;======================================================================

;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
				    fallback-launcher
				    (loop (car tal)(cdr tal)))))))
		      ;; no match, try again
		      (if (null? tal)
			  fallback-launcher
			  (loop (car tal)(cdr tal))))))))
	fallback-launcher)))

;;======================================================================
;; NMSG AND NEW API
;;======================================================================

;; nm based server
;;
(define (nm:start-server dbconn #!key (given-host-name #f))
  (let* ((srvdat    (start-raw-server given-host-name: given-host-name))
	 (host-name (srvdat-host srvdat))
	 (soc       (srvdat-soc srvdat)))
    
    ;; start the queue processor (save for second round of development)
    ;;
    ;; (thread-start! (queue-processory dbconn) "Queue processor")
    ;; msg is an alist
    ;;  'r host:port  <== where to return the data
    ;;  'p params     <== data to apply the command to
    ;;  'e j|s|l      <== encoding of the params. default is s (sexp), if not specified is assumed to be default
    ;;  'c command    <== look up the function to call using this key
    ;;
    (let loop ((msg-in (nn-recv soc)))
      (if (not (equal? msg-in "quit"))
	  (let* ((dat        (decode msg-in))
		 (host-port  (alist-ref 'r dat)) ;; this is for the reverse req rep where the server is a client of the original client
		 (params     (alist-ref 'p dat))
		 (command    (let ((c (alist-ref 'c dat)))(if c (string->symbol c) #f)))
		 (all-good   (and host-port params command (hash-table-exists? *commands* command))))
	    (if all-good
		(let ((cmddat (make-qitem
			       command:   command
			       host-port: host-port
			       params:    params)))
		  (queue-push cmddat) 		;; put request into the queue
		  (nn-send soc "queued"))         ;; reply with "queued"
		(print "ERROR: BAD request " dat))
	    (loop (nn-recv soc)))))
    (nn-close soc)))
  


;;======================================================================
;; D A S H B O A R D   U S E R   V I E W S
;;======================================================================

;; first read ~/views.config if it exists, then read $MTRAH/views.config if it exists
;;
(define (common:load-views-config)