Megatest

Check-in [eb12585951]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Changed open-run-close to take a proc for db opener, #f to use open-db or an already opened db
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | monitor-cleanup
Files: files | file ages | folders
SHA1: eb12585951f3543bcb6560c9414253fbcdfbc3e5
User & Date: matt on 2012-10-27 15:24:30
Other Links: branch diff | manifest | tags
Context
2012-10-27
16:52
interim commit with partial transition to new monitor server support check-in: b6b960aae3 user: matt tags: monitor-cleanup
15:24
Changed open-run-close to take a proc for db opener, #f to use open-db or an already opened db check-in: eb12585951 user: matt tags: monitor-cleanup
11:45
Added templates for server and client functions in tasks check-in: 19e4993de3 user: matt tags: monitor-cleanup
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [4acdad91df] to [e33fe9021a].

︙
68
69
70
71
72
73
74
75





76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98








99
100


101
102
103
104
105
106
107

68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
















87
88
89
90
91
92
93
94


95
96
97
98
99
100
101
102
103








-
+
+
+
+
+







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








	(db:initialize db))
    (db:set-sync db)
    db))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (let* ((db   (if idb idb (open-db)))
  (let* ((db   (if idb 
		   (if (procedure? idb)
		       (idb)
		       idb)
		   (open-db)))
	 (res #f))
    (set! res (apply proc db params))
    (if (not idb)(sqlite3:finalize! db))
    (debug:print-info 11 "open-run-close-no-exception-handling END" )
    res))

(define (open-run-close-exception-handling proc idb . params)
  (debug:print-info 11 "open-run-close-exception-handling START, idb=" idb ", params=" params)
  (let ((runner (lambda ()
		  (let* ((db   (if idb idb (open-db)))
			 (res #f))
		    (set! res (apply proc db params))
		    (if (not idb)(sqlite3:finalize! db))
		    (debug:print-info 11 "open-run-close-no-exception-handling END" )
		    res))))
    (handle-exceptions
     exn
     (begin
       (debug:print 0 "EXCEPTION: database probably overloaded?")
       (debug:print 0 "  " ((condition-property-accessor 'exn 'message) exn))
       (print-call-chain)
       (thread-sleep! (random 120))
       (debug:print-info 0 "trying db call one more time....")
  (handle-exceptions
   exn
   (begin
     (debug:print 0 "EXCEPTION: database probably overloaded?")
     (debug:print 0 "  " ((condition-property-accessor 'exn 'message) exn))
     (print-call-chain)
     (thread-sleep! (random 120))
     (debug:print-info 0 "trying db call one more time....")
       (runner))
     (runner))))
     (apply open-run-close-no-exception-handling proc idb params))
   (apply open-run-close-no-exception-handling proc idb params)))

(define open-run-close open-run-close-exception-handling)

(define *global-delta* 0)
(define *last-global-delta-printed* 0)

(define (open-run-close-measure  proc idb . params)
︙

Modified server.scm from [14b13ae1eb] to [b66b09e982].

︙
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36

22
23
24
25
26
27
28

29
30
31
32
33
34
35
36








-
+








(declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.

(include "common_records.scm")
(include "db_records.scm")

(define (server:run hostn)
  (debug:print 0 "Attempting to start the server ...")
  (let ((host:port      (open-run-close db:get-var #f "SERVER"))) ;; do whe already have a server running?
  (let ((host:port      (open-run-close db:get-var open-db "SERVER"))) ;; do whe already have a server running?
    (if host:port 
	(begin
	  (debug:print 0 "NOTE: server already running.")
	  (if (server:client-setup)
	      (begin 
		(debug:print-info 0 "Server is alive, not starting another")
		;;(exit)
︙

This page was generated in about 0.129s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00