Megatest

Check-in [77149209be]
Login
Overview
Comment:Partial (but broken) usage of dbmod.scm
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-wip
Files: files | file ages | folders
SHA1: 77149209be527afd33c4f67b37e55cb5d64b982b
User & Date: matt on 2019-10-15 05:10:48
Other Links: branch diff | manifest | tags
Context
2019-10-16
17:59
refactoring in flight. does not compile. check-in: 028f0d8c40 user: mrwellan tags: v1.65-wip
2019-10-15
05:10
Partial (but broken) usage of dbmod.scm check-in: 77149209be user: matt tags: v1.65-wip
04:29
Added mod files (but they are not used yet). check-in: fc8c642fb9 user: matt tags: v1.65-wip
Changes

Modified api.scm from [9f9aa7e246] to [c2592bc5da].

20
21
22
23
24
25
26



27
28
29
30
31
32
33

(use srfi-69 posix)

(declare (unit api))
(declare (uses rmt))
(declare (uses db))
(declare (uses tasks))




;; api:read-only-queries and api:execute-requests have been moved into common_records


;; These are called by the server on recipt of /api calls
;;    - keep it simple, only return the actual result of the call, i.e. no meta info here
;;







>
>
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

(use srfi-69 posix)

(declare (unit api))
(declare (uses rmt))
(declare (uses db))
(declare (uses tasks))

(declare (uses apimod))
(import apimod)

;; api:read-only-queries and api:execute-requests have been moved into common_records


;; These are called by the server on recipt of /api calls
;;    - keep it simple, only return the actual result of the call, i.e. no meta info here
;;

Modified commonmod.scm from [c7972f9b4b] to [b77b64f35a].

21
22
23
24
25
26
27





28
29
30
31
32
33
34
(declare (unit commonmod))

(module commonmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)






;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;; 
;; (define (set-functions dbgp dbgpinfo)
;;   (set! debug:print dbgp)
;;   (set! debug:print-info dbgpinfo))







>
>
>
>
>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
(declare (unit commonmod))

(module commonmod
	*
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18)

(define (db:dbdat-get-path dbdat)
  (if (pair? dbdat)
      (cdr dbdat)
      #f))

;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;; 
;; (define (set-functions dbgp dbgpinfo)
;;   (set! debug:print dbgp)
;;   (set! debug:print-info dbgpinfo))

Modified db.scm from [15fede171d] to [3e7b7fa94e].

39
40
41
42
43
44
45
46



47
48
49
50
51
52
53
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

(declare (uses rmtmod))
(import rmtmod)





(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)

;;======================================================================
;;  R E C O R D S







|
>
>
>







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

(declare (uses rmtmod))
(import rmtmod)
(declare (uses dbmod))
(import dbmod)
(declare (uses commonmod))
(import commonmod)

(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)

;;======================================================================
;;  R E C O R D S
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
      (if (stack-empty? (dbr:dbstruct-dbstack dbstruct))
          (let ((newdb (db:open-megatest-db path: (db:dbfile-path))))
            ;; (stack-push! (dbr:dbstruct-dbstack dbstruct) newdb)
            newdb)
          (stack-pop! (dbr:dbstruct-dbstack dbstruct)))
      (db:open-db dbstruct)))

;; ;; legacy handling of structure for managing db's. Refactor this into dbr:?
(define (db:dbdat-get-db dbdat)
  (if (pair? dbdat)
      (car dbdat)
      dbdat))

(define (db:dbdat-get-path dbdat)
  (if (pair? dbdat)
      (cdr dbdat)
      #f))

;; mod-read:
;;     'mod   modified data
;;     'read  read data
;; Locks the mutex and depending on 'mod or 'read passed, sets the last timestamp in dbstruct
;;
;; (define (db:done-with dbstruct run-id mod-read)
;;   (if (not (sqlite3:database? dbstruct))







<
<
<
<
<
<
<
<
<
<
<







116
117
118
119
120
121
122











123
124
125
126
127
128
129
      (if (stack-empty? (dbr:dbstruct-dbstack dbstruct))
          (let ((newdb (db:open-megatest-db path: (db:dbfile-path))))
            ;; (stack-push! (dbr:dbstruct-dbstack dbstruct) newdb)
            newdb)
          (stack-pop! (dbr:dbstruct-dbstack dbstruct)))
      (db:open-db dbstruct)))












;; mod-read:
;;     'mod   modified data
;;     'read  read data
;; Locks the mutex and depending on 'mod or 'read passed, sets the last timestamp in dbstruct
;;
;; (define (db:done-with dbstruct run-id mod-read)
;;   (if (not (sqlite3:database? dbstruct))

Modified dbmod.scm from [19f006a922] to [3c23163cb6].

26
27
28
29
30
31
32






33
34
35
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable)
(import commonmod)
;; (use (prefix ulex ulex:))

(include "common_records.scm")








)







>
>
>
>
>
>



26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix typed-records srfi-18 srfi-69 format ports srfi-1 matchable)
(import commonmod)
;; (use (prefix ulex ulex:))

(include "common_records.scm")

;; ;; legacy handling of structure for managing db's. Refactor this into dbr:?
(define (db:dbdat-get-db dbdat)
  (if (pair? dbdat)
      (car dbdat)
      dbdat))


)

Modified rmt.scm from [3b9540724d] to [93351dcc43].

20
21
22
23
24
25
26

27
28

29

30
31
32
33
34
35
36

(use format typed-records) ;; RADT => purpose of json format??

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")

(declare (uses rmtmod))


(import rmtmod)

(set-fn 'server:expiration-timeout server:expiration-timeout)
(set-fn 'common:get-homehost       common:get-homehost)
(set-fn 'server:check-if-running   server:check-if-running)
(set-fn 'api:execute-requests      api:execute-requests)
(set-fn 'http-transport:close-connections  http-transport:close-connections )
(set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive)
(set-fn 'server:kind-run  server:kind-run)







>

|
>
|
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

(use format typed-records) ;; RADT => purpose of json format??

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(include "common_records.scm")

(declare (uses rmtmod))
(import rmtmod)
(declare (uses commonmod))
(import commonmod)

(set-fn 'server:expiration-timeout server:expiration-timeout)
(set-fn 'common:get-homehost       common:get-homehost)
(set-fn 'server:check-if-running   server:check-if-running)
(set-fn 'api:execute-requests      api:execute-requests)
(set-fn 'http-transport:close-connections  http-transport:close-connections )
(set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive)
(set-fn 'server:kind-run  server:kind-run)

Modified rmtmod.scm from [798b93ee00] to [b74f8e8186].

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
    (set! server:ping                            i)
    (set! common:force-server?                   j)
    )))

(define (rmt:open-qry-close-locally log-port multi-sync-mutex cmd run-id params alldat #!key (remretries 5))
  (let* ((ro-queries     (alldat-read-only-queries alldat))
	 (qry-is-write   (not (member cmd ro-queries)))
	 (db-file-path   (exec-fn 'db:dbfile-path)) ;;  0))
	 (dbstruct-local (exec-fn 'db:setup #t))  ;; make-dbr:dbstruct path:  dbdir local: #t)))
	 (read-only      (not (file-write-access? db-file-path)))
	 (start          (current-milliseconds))
	 (resdat         (if (not (and read-only qry-is-write))
			     (let ((v (exec-fn 'api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
			       (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong..
				exn               ;;  This is an attempt to detect that situation and recover gracefully







|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
    (set! server:ping                            i)
    (set! common:force-server?                   j)
    )))

(define (rmt:open-qry-close-locally log-port multi-sync-mutex cmd run-id params alldat #!key (remretries 5))
  (let* ((ro-queries     (alldat-read-only-queries alldat))
	 (qry-is-write   (not (member cmd ro-queries)))
	 (db-file-path   (db:dbfile-path)) ;;  0))
	 (dbstruct-local (exec-fn 'db:setup #t))  ;; make-dbr:dbstruct path:  dbdir local: #t)))
	 (read-only      (not (file-write-access? db-file-path)))
	 (start          (current-milliseconds))
	 (resdat         (if (not (and read-only qry-is-write))
			     (let ((v (exec-fn 'api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
			       (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong..
				exn               ;;  This is an attempt to detect that situation and recover gracefully