Megatest

Check-in [36613fed83]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-tcp-inmem
Files: files | file ages | folders
SHA1: 36613fed833f08d047b9f0dcb203b7a9c9f342c0
User & Date: matt on 2023-02-16 11:21:27
Other Links: branch diff | manifest | tags
Context
2023-02-16
13:24
wip, compiles check-in: 12dfb79088 user: matt tags: v1.80-tcp-inmem
11:21
wip check-in: 36613fed83 user: matt tags: v1.80-tcp-inmem
2023-02-15
21:37
wip check-in: 0588f96563 user: matt tags: v1.80-tcp-inmem
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dbfile.scm from [575621e170] to [34c4e7dee1].

︙
54
55
56
57
58
59
60

61
62
63
64
65

66
67
68
69
70
71
72

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74








+





+








;;
(defstruct dbr:dbstruct
  (areapath  #f)
  (homehost  #f)
  (tmppath   #f)
  (read-only #f)
  (subdbs (make-hash-table))
  ;;
  ;; for the inmem approach (see dbmod.scm)
  ;; this is one db per server
  (inmem     #f)  ;; handle for the in memory copy
  (dbfile    #f)  ;; path to the db file on disk
  (ondiskdb  #f)  ;; handle for the on-disk file
  (dbdat     #f)  ;; create a dbdat for the downstream calls such as db:with-db
  )

;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
  (dbname      #f) ;; .megatest/1.db
  (mtdbfile    #f) ;; mtrah/.megatest/1.db
︙
1014
1015
1016
1017
1018
1019
1020

1021



1022
1023
1024
1025
1026
1027
1028

1016
1017
1018
1019
1020
1021
1022
1023

1024
1025
1026
1027
1028
1029
1030
1031
1032
1033








+
-
+
+
+








;; db access stuff
;;======================================================================

;; call with dbinit=db:initialize-main-db
;;
(define (db:open-db dbstruct run-id dbinit)
  ;; (mutex-lock! *db-open-mutex*)
  (let* ((dbdat (case (rmt:transport-mode)
  (let* ((dbdat (dbfile:open-db dbstruct run-id dbinit)))
		  ((http) (dbfile:open-db dbstruct run-id dbinit))
		  ((tcp)  (dbmod:open-db  dbstruct run-id dbinit))
		  (else (assert #f "FATAL: rmt:transport-node not correct value"(rmt:transport-mode))))))
    (set! *db-write-access* (not (dbr:dbdat-read-only dbdat)))
    ;; (mutex-unlock! *db-open-mutex*)
    dbdat))

(define dbfile:db-init-proc (make-parameter #f))

;; in xmaxima this gives a curve close to what I want:
︙

Modified dbmod.scm from [75595b50f0] to [2f43f80363].

︙
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

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


86
87
88
89
90
91
92
93
94
95








+
+
+
+
+
+
+
+
+







-
+
+

-
-
+
+
+









(define (dbmod:open-inmem-db initproc)
  (let* ((db      (sqlite3:open-database ":memory:"))
	 (handler (sqlite3:make-busy-timeout 3600)))
    (sqlite3:set-busy-handler! db handler)
    (initproc db)
    db))

(define (dbmod:open-db dbstruct run-id dbinit)
  (or (dbr:dbstruct-dbdat dbstruct)
      (let* ((dbdat (make-dbr:dbdat
		     dbfile: (dbr:dbstruct-dbfile dbstruct)
		     dbh:    (dbr:dbstruct-inmen  dbstruct)
		     )))
	(dbr:dbstruct-dbdat-set! dbstruct dbdat)
	dbdat)))

;; Open the inmem db and the on-disk db
;; populate the inmem db with data
;;
;; Updates fields in dbstruct
;; Returns dbstruct
;;
;; This routine creates the db if not found
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;; 
(define (db:open-dbmoddb dbstruct run-id init-proc) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbfname      (dbmod:run-id->dbfname run-id))
(define (db:open-dbmoddb areapath run-id init-proc #!key (dbstruct-in #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbstruct     (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
	 (dbfname      (dbmod:run-id->dbfname run-id))
	 (dbpath       (dbmod:get-dbdir dbstruct run-id))             ;; directory where all the .db files are kept
	 (dbfullname   (dbmod:run-id->full-dbfname dbstruct run-id))
	 (dbexists     (file-exists? dbfullname))
	 (inmem        (dbmod:open-inmem-db init-proc))
	 (write-access (file-write-access? dbpath))
	 (db           (dbfile:with-simple-file-lock
			(conc dbfullname".lock")
︙

Modified megatest.scm from [614e5cde2d] to [af4f96a022].

︙
932
933
934
935
936
937
938
939

940
941
942
943
944
945
946

932
933
934
935
936
937
938

939
940
941
942
943
944
945
946








-
+








    (let* ((run-id (args:get-arg-number "-run-id"))
	   (tl        (launch:setup)))
      (case (rmt:transport-mode)
	((http)(http-transport:launch))
	((tcp)
	 (debug:print 0 *default-log-port* "INFO: Running using tcp method.")
	 (if run-id
	     (tt:start-server tl (dbmod:run-id->dbfname run-id))
	     (tt:start-server tl (dbmod:run-id->dbfname run-id) api:dispatch-request)
	     (begin
	       (debug:print 0 *default-log-port* "ERROR: transport mode is tcp - -run-id is required.")
	       (exit 1))))
	(else (debug:print 0 *default-log-port* "ERROR: rmt:transport-mode value not recognised "(rmt:transport-mode))))
      (set! *didsomething* #t)))

;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to
︙

Modified tcp-transportmod.scm from [aad850169c] to [fc74e296d0].

︙
141
142
143
144
145
146
147
148

149
150

151
152
153
154
155
156
157

141
142
143
144
145
146
147

148
149

150
151
152
153
154
155
156
157








-
+

-
+








;;
(define (tt:start-server areapath dbfname handler)
  ;; is there already a server for this dbfile? Then exit.
  (let* ((ttdat  (make-tt areapath: areapath))
	 (servers (tt:find-server ttdat dbfname)))
    (tt-handler-set! ttdat handler)
    (if (null? servers)
	(begin
	(let* ((dbstruct (dbmod:open-dbmoddb areapath run-id (dbfile:db-init-db))))
	  (tt:start-tcp-server ttdat) ;; start the tcp-server which applies handler to incoming data
	  (tt:keep-running ttdat dbfname))
	  (tt:keep-running ttdat dbfname handler))
	(begin
	  (debug:print 0 *default-log-port* "INFO: found server(s) already running for db "dbfname", "(string-intersperse servers ",")" Exiting.")
	  (exit)))))

;; find a port and start tcp-server
;;
(define (tt:start-tcp-server ttdat)
︙

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