Megatest

Diff
Login

Differences From Artifact [cab71edb67]:

To Artifact [49da501f89]:


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
81
82
83
84
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
81
82
83
84
85







+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    (execute db "UPDATE clients SET num_accesses=num_accesses+1 WHERE id=?;" cid)))

(define db (open-db))
;; (define queuelst '())
;; (define mx1 (make-mutex))

(define (process-queue queuelst)
  (let ((queuelen (length queuelst)))
  (for-each
   (lambda (item)
     (let ((cname (vector-ref item 1))
	   (clcmd (vector-ref item 2))
	   (cdata (vector-ref item 3)))
       (send-message pub cname send-more: #t)
       (send-message pub (case clcmd
			   ((sync)
			    "ok")
			   ((set)
			    (apply execute db "INSERT OR REPLACE INTO vars (var,val) VALUES (?,?);" (string-split cdata))
			    "ok")
			   ((get)
			    (let ((res "noval"))
			      (for-each-row
			       (lambda (val)
				 (set! res val))
			       db 
			       "SELECT val FROM vars WHERE var=?;" cdata)
			      res))
			   (else (conc "unk cmd: " clcmd))))))
   queuelst))
    (for-each
     (lambda (item)
       (let ((cname (vector-ref item 1))
	     (clcmd (vector-ref item 2))
	     (cdata (vector-ref item 3)))
	 (send-message pub cname send-more: #t)
	 (send-message pub (case clcmd
			     ((sync)
			      (conc queuelen))
			     ((set)
			      (apply execute db "INSERT OR REPLACE INTO vars (var,val) VALUES (?,?);" (string-split cdata))
			      "ok")
			     ((get)
			      (let ((res "noval"))
				(for-each-row
				 (lambda (val)
				   (set! res val))
				 db 
				 "SELECT val FROM vars WHERE var=?;" cdata)
				res))
			     (else (conc "unk cmd: " clcmd))))))
     queuelst)))

(define th1 (make-thread 
	     (lambda ()
	       (let ((last-run 0)) ;; current-seconds when run last
		 (let loop ((queuelst '()))
		   (let* ((indat (receive-message* pull))
			  (parts (string-split indat ":"))
100
101
102
103
104
105
106

107
108


109
110
111







112
113
114
115
116



101
102
103
104
105
106
107
108


109
110



111
112
113
114
115
116
117
118
119
120
121

122
123
124







+
-
-
+
+
-
-
-
+
+
+
+
+
+
+




-
+
+
+
	     "server thread"))

(include "mockupclientlib.scm")

;; send a sync to the pull port
(define th2 (make-thread
	     (lambda ()
	       (let ((last-action-time (current-seconds)))
	       (let loop ()
		 (thread-sleep! 5)
		 (let loop ()
		   (thread-sleep! 5)
		 ;; (print "Sending sync from server")
		 (dbaccess "server" 'sync "nada" #f)
		 (loop)))
		   (let ((queuelen (string->number (dbaccess "server" 'sync "nada" #f)))
			 (last-action-delta (- (current-seconds) last-action-time)))
		     (print "Server: Got queuelen=" queuelen ", last-action-delta=" last-action-delta)
		     (if (> queuelen 1)(set! last-action-time (current-seconds)))
		     (if (< last-action-delta 15)
			 (loop)
			 (print "Server exiting, 15 seconds since last access"))))))
	     "sync thread"))

(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
(thread-join! th2)

(print "Server exited!")