Megatest

Check-in [ea08cd04fb]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Separate dbs for dashboard.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-dboard-dbs
Files: files | file ages | folders
SHA1: ea08cd04fb224d2a12c2dc2196cceadde4910dcd
User & Date: matt on 2023-05-24 06:24:29
Other Links: branch diff | manifest | tags
Context
2023-05-29
20:49
Fixed db init - should be if it didn't exists then init. Added running of dashboard syncer which seems to be somewhat working. Leaf check-in: ac9bff739e user: matt tags: v1.80-dboard-dbs
2023-05-24
06:24
Separate dbs for dashboard. check-in: ea08cd04fb user: matt tags: v1.80-dboard-dbs
04:16
Added exception handlers on transactions on sync and in one additional with-input in simple locks. check-in: 9062c1c10d user: matt tags: v1.80
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified TODO from [fa3d981ca6] to [14d60a1c73].

︙
14
15
16
17
18
19
20



21
22
23
24
25
26
27

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30








+
+
+








# 
#     You should have received a copy of the GNU General Public License
#     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

TODO
====

23WW21
. Dashboard needs its own cache db in /tmp

23WW07
. Remove use of *dbstruct-dbs*

WW15
. fill newview matrix with data, filter pipeline gui elements
. improve [script], especially indent handling
︙

Modified dashboard-transport-mode.scm.template from [a7eb4115fd] to [ae157b10fd].

︙
11
12
13
14
15
16
17
18

19
20
21
22

11
12
13
14
15
16
17

18
19
20
21
22








-
+






;; uncomment this block to test without tcp or cachedb
;; (dbfile:sync-method 'none)
;; (dbfile:cache-method 'none)
;; (rmt:transport-mode 'nfs)

;; uncomment this block to test with tcp and cachedb
(dbfile:sync-method 'none) ;; original was causing crash on start. 
(dbfile:sync-method 'attach) ;; original was causing crash on start. 
(dbfile:cache-method 'none)
(rmt:transport-mode 'nfs)

Modified dbfile.scm from [5c3217f805] to [8d04f9a6ab].

︙
198
199
200
201
202
203
204
205
206


207
208
209
210
211
212
213

198
199
200
201
202
203
204


205
206
207
208
209
210
211
212
213








-
-
+
+








	   subdbs)
           #t
          )
          #f
  )
)

(define (dbfile:make-tmpdir-name areapath)
  (let* ((dname (conc "/tmp/"(current-user-name)"/" (string-translate areapath "/" "."))))
(define (dbfile:make-tmpdir-name areapath tmpadj)
  (let* ((dname (conc "/tmp/"(current-user-name)"/" (string-translate areapath "/" ".") tmpadj)))
    (create-directory dname #t)
    dname))

(define (dbfile:run-id->path apath run-id)
  (conc apath"/"(dbfile:run-id->dbname run-id)))

(define (db:dbname->path apath dbname)
︙

Modified dbmod.scm from [9a189716e8] to [06c647bca6].

︙
69
70
71
72
73
74
75
76

77
78
79
80
81
82

83
84
85
86
87
88
89

69
70
71
72
73
74
75

76
77
78
79
80
81

82
83
84
85
86
87
88
89








-
+





-
+








;;======================================================================
;; Read-only cachedb cached direct from disk method
;;======================================================================

(define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct

;; called in rmt.scm nfs-transport-handler
(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath)
(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath #!key (tmpadj ""))
  (assert areapath "FATAL: dbmod:nfs-get-dbstruct called without areapath set.")
  (let* ((dbfname  (dbmod:run-id->dbfname run-id))
	 (dbstruct (hash-table-ref/default *dbmod:nfs-db-handles* dbfname #f)))
    (if dbstruct
	dbstruct
	(let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'fromdisk)))
	(let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'fromdisk tmpadj: tmpadj)))
	  (hash-table-set! *dbmod:nfs-db-handles* dbfname newdbstruct)
	  newdbstruct))))

;;======================================================================
;; The cachedb one-db file per server method goes in here
;;======================================================================
︙
189
190
191
192
193
194
195
196


197
198
199
200
201
202
203

204
205
206
207
208
209
210

189
190
191
192
193
194
195

196
197
198
199
200
201
202
203

204
205
206
207
208
209
210
211








-
+
+






-
+








;; Returns dbstruct
;;
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;; 
(define (dbmod:open-dbmoddb areapath run-id dbfname-in init-proc keys
			    #!key (dbstruct-in #f)
			    ;; (dbcontext 'megatest) ;; use dashboard to do the dashboard 
			    ;; (dbcontext 'megatest) ;; use dashboard to do the dashboard
			    (tmpadj  "")       ;; add to tmp path
			    (syncdir 'todisk)) ;; todisk is used when caching in /tmp and writing data back to MTRAH
  (let* ((dbstruct     (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
	 (dbfname      (or dbfname-in (dbmod:run-id->dbfname run-id)))
	 (dbpath       (dbmod:get-dbdir dbstruct))             ;; directory where all the .db files are kept
	 (dbfullname   (conc dbpath"/"dbfname)) ;; (dbmod:run-id->full-dbfname dbstruct run-id))
	 (dbexists     (file-exists? dbfullname))
	 (tmpdir       (dbfile:make-tmpdir-name areapath))
	 (tmpdir       (dbfile:make-tmpdir-name areapath tmpadj))
	 (tmpdb        (let* ((fname (conc tmpdir"/"dbfname)))
			 fname))
	 (cachedb        (dbmod:open-cachedb-db init-proc
					    ;; (if (eq? (dbfile:cache-method) 'cachedb)
					    ;; 	#f
					    tmpdb
					    ;; )
︙
224
225
226
227
228
229
230

231


232
233
234
235
236
237
238

225
226
227
228
229
230
231
232

233
234
235
236
237
238
239
240
241








+
-
+
+








    (dbr:dbstruct-dbtmpname-set! dbstruct tmpdb)
    (dbr:dbstruct-dbfname-set!   dbstruct dbfname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)
				   (if *sync-in-progress*
				       (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
				       (let* ((syncer-logfile    (conc areapath"/logs/"dbfname"-syncer.log"))
					      (sync-cmd          (if (eq? syncdir 'todisk)
					      (sync-cmd          (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "tmpdb" -to "dbfullname" -period 5 -timeout 10 &"))
								     (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "tmpdb" -to "dbfullname" -period 5 -timeout 10 &")
								     (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "dbfullname" -to "tmpdb" -period 5 -timeout 10 &")))
					      (synclock-file     (conc dbfullname".lock"))
					      (syncer-running-file (conc dbfullname"-sync-running"))
					      (synclock-mod-time (if (file-exists? synclock-file)
								     (handle-exceptions
									 exn
								       #f
								       (file-modification-time synclock-file))
︙
493
494
495
496
497
498
499





500

501
502
503
504
505
506
507

496
497
498
499
500
501
502
503
504
505
506
507

508
509
510
511
512
513
514
515








+
+
+
+
+
-
+








	       (dest-exists  (file-exists? destdbfile)))
	  (assert dest-exists "FATAL: sync called with non-existant file, "destdbfile)
	  ;; attach the destdbfile
	  ;; for each table
	  ;;    insert into dest.<table> select * from src.<table> where last_update>last_update
	  ;; done
	  (debug:print 0 *default-log-port* "Attaching "destdbfile" as auxdb")
	  (handle-exceptions
	      exn
	      (begin
		(debug:print 0 "ATTACH failed, exiting. exn="(condition->list exn))
		(exit 1))
	  (sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;"))
	    (sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;")))
	  (for-each
	   (lambda (table)
	     (let* ((tbldat (alist-ref table tables equal?))
		    (fields (map car tbldat))
		    (no-id-fields (filter (lambda (x)(not (equal? x "id"))) fields))
		    (fields-str (string-intersperse fields ","))
		    (no-id-fields-str (string-intersperse no-id-fields ","))
︙

Modified rmt.scm from [0af3ea0170] to [8f04a626a2].

︙
115
116
117
118
119
120
121
122

123
124
125
126
127
128
129

115
116
117
118
119
120
121

122
123
124
125
126
127
128
129








-
+








      ((http)(http-transport-handler runremote cmd rid params attemptnum area-dat areapath readonly-mode))
      ((tcp) (tcp-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
      ((nfs) (nfs-transport-handler  runremote cmd rid params attemptnum area-dat areapath readonly-mode testsuite mtexe))
      )))

(define (nfs-transport-handler  runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
  (let* ((keys     (common:get-fields *configdat*))
	 (dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath)))
	 (dbstruct (dbmod:nfs-get-dbstruct run-id keys (dbfile:db-init-proc) areapath tmpadj: "/dashboard")))
    (api:dispatch-request dbstruct cmd run-id params)))
	 
(define (tcp-transport-handler runremote cmd run-id params attemptnum area-dat areapath readonly-mode testsuite mtexe)
  (if (not runremote)
      (let* ((newremote  (make-and-init-remote areapath)))
	(set! *runremote* newremote)
	(set! runremote newremote)))
︙

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