Megatest

Check-in [47e78ace28]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:updates and fixes to archive megatestdb
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 47e78ace287c36accf8e3c29226fb01175423be9
User & Date: pjhatwal on 2020-08-18 12:13:04
Other Links: branch diff | manifest | tags
Context
2020-08-18
12:53
Removed some unused code. Upped rest time from 12 seconds to 30 seconds for runners in parallel check-in: d25ec76b5c user: mrwellan tags: v1.65, v1.6562
12:13
updates and fixes to archive megatestdb check-in: 47e78ace28 user: pjhatwal tags: v1.65
2020-08-17
18:58
Added support for profiling, moved inter-test-delay to better location so initial registration is faster. check-in: f5657ea556 user: matt tags: v1.65
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified api.scm from [873dee2312] to [cb8c71faca].

︙
117
118
119
120
121
122
123
124



125
126
127
128
129
130
131

117
118
119
120
121
122
123

124
125
126
127
128
129
130
131
132
133








-
+
+
+








    delete-steps-for-test
    ;; TEST DATA
    test-data-rollup
    csv->test-data

    ;; MISC
    sync-inmem->db

    drop-all-triggers
    create-all-triggers
    update-tesdata-on-repilcate-db 
    ;; TESTMETA
    testmeta-add-record
    testmeta-update-field

    ;; TASKS
    tasks-add
    tasks-set-state-given-param-key
︙
227
228
229
230
231
232
233
234


235
236
237
238
239
240
241

229
230
231
232
233
234
235

236
237
238
239
240
241
242
243
244








-
+
+








                   ((test-data-rollup)             (apply db:test-data-rollup dbstruct params))
                   ((csv->test-data)               (apply db:csv->test-data dbstruct params))

                   ;; MISC
                   ((sync-inmem->db)               (let ((run-id (car params)))
                                                     (db:sync-touched dbstruct run-id force-sync: #t)))
                   ((mark-incomplete)              (apply db:find-and-mark-incomplete dbstruct params))

                   ((create-all-triggers)          (db:create-all-triggers dbstruct))
                   ((drop-all-triggers)            (db:drop-all-triggers dbstruct)) 
                   ;; TESTMETA
                   ((testmeta-add-record)       (apply db:testmeta-add-record dbstruct params))
                   ((testmeta-update-field)     (apply db:testmeta-update-field dbstruct params))
                   ((get-tests-tags)            (db:get-tests-tags dbstruct))

                   ;; TASKS
                   ((tasks-add)                 (apply tasks:add dbstruct params))
︙
292
293
294
295
296
297
298

299
300
301
302
303
304
305

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309








+









                   ;; RUNS
                   ((get-run-info)                 (apply db:get-run-info dbstruct params))
                   ((get-run-status)               (apply db:get-run-status dbstruct params))
                   ((get-run-state)                (apply db:get-run-state dbstruct params))
                   ((set-run-status)               (apply db:set-run-status dbstruct params))
                   ((set-run-state-status)  			 (apply db:set-run-state-status dbstruct params))
                   ((update-tesdata-on-repilcate-db) (apply db:update-tesdata-on-repilcate-db  dbstruct params)) 
                   ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
                   ((get-test-id)                  (apply db:get-test-id dbstruct params))
                   ((get-tests-for-run-mindata)    (apply db:get-tests-for-run-mindata dbstruct params))
                   ;; ((get-tests-for-runs-mindata)   (apply db:get-tests-for-runs-mindata dbstruct params))
                   ((get-runs)                     (apply db:get-runs dbstruct params))
                   ((simple-get-runs)              (apply db:simple-get-runs dbstruct params))
                   ((get-num-runs)                 (apply db:get-num-runs dbstruct params))
︙

Modified archive.scm from [8417ecbb27] to [f6080386d6].

︙
134
135
136
137
138
139
140

141
142
143
144
145
146
147
148
149
150
151
152
153
154

155
156
157


158
159
160
161
162
163
164
165
166
167
168
169

170
171
172
173
174
175
176

134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171


172
173
174
175
176
177
178
179








+














+



+
+










-
-
+








;;
(define (archive:run-bup archive-command run-id run-name tests rp-mutex bup-mutex)
  ;; move the getting of archive space down into the below block so that a single run can 
  ;; allocate as needed should a disk fill up
  ;;
  (let* ((blockid-cache  (make-hash-table))
	 (tsname         (common:get-testsuite-name))
         (target         (string-intersperse (map cadr (rmt:get-key-val-pairs run-id)) "/"))
	 (min-space      (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
	 (arch-groups    (make-hash-table)) ;; archive groups, each corrosponds to a bup area
	 (disk-groups    (make-hash-table)) ;; 
	 (test-groups    (make-hash-table)) ;; these two (disk and test groups) could be combined nicely
	 (test-dirs      (make-hash-table))
	 (bup-exe        (or (configf:lookup *configdat* "archive" "bup") "bup"))
	 (compress       (or (configf:lookup *configdat* "archive" "compress") "9"))
	 (linktree       (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")))
	 (archiver       (let ((s (configf:lookup *configdat* "archive" "archiver")))
			   (if s (string->symbol s) 'bup)))
	 (archiver-cmd   (case archiver
			   ((tar) "tar cfj ARCHIVE_NAME.tar.bz2 ")
			   ((7z)  " 7z u -t7z -m0=lzma -mx=9 -mfb=64 -md=32m -ms=on ARCHIVE_NAME.7z ")
			   (else #f)))
         (src-archive-linktree (rmt:get-var "src-archive-linktree"))  
	 (print-prefix      "Running: ") ;; change to #f to turn off printing
	 (preclean-spec  (configf:get-section *configdat* "archive-preclean")))

     (if (or (not src-archive-linktree) (not (equal? src-archive-linktree linktree)))      
         (rmt:set-var "src-archive-linktree"  linktree))
    ;;     (tests:match patt testname itempath)
    
    ;; from the test info bin the path to the test by stem
    ;;
    (for-each
     (lambda (test-dat)
       (let* ((item-path         (db:test-get-item-path test-dat))
	      (test-name         (db:test-get-testname  test-dat))
	      (test-id           (db:test-get-id        test-dat))
	      (run-id            (db:test-get-run_id    test-dat))
	      (target            (string-intersperse (map cadr (rmt:get-key-val-pairs run-id)) "/"))
	      
	      	      
	      (toplevel/children (and (db:test-get-is-toplevel test-dat)
				      (> (rmt:test-toplevel-num-items run-id test-name) 0)))
	      (test-partial-path (conc target "/" run-name "/" (db:test-make-full-name test-name item-path)))
	      ;; note the trailing slash to get the dir inspite of it being a link
	      (test-path         (conc linktree "/" test-partial-path))
	      (mutex-lock! rp-mutex)
	      (test-physical-path (if (common:file-exists? test-path)
︙
314
315
316
317
318
319
320

321
322

















































































































323
324
325
326
327
328
329

317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446








+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








		(rmt:test-set-archive-block-id run-id test-id archive-id)
		(if (member (symbol->string archive-command) '("save-remove"))
                    (begin 
                     (debug:print-info 0 *default-log-port* "remove testdat")
		    (runs:remove-test-directory test-dat 'archive-remove)))))
	    (hash-table-ref test-groups test-base)))))
       (hash-table-keys disk-groups))
      
    #t))

(define (archive:megatest-db target-patt run-patt)
 (let* ((blockid-cache  (make-hash-table))
        (tsname         (common:get-testsuite-name))
        (min-space      (string->number (or (configf:lookup *configdat* "archive" "minspace") "1000")))
        (bup-exe        (or (configf:lookup *configdat* "archive" "bup") "bup"))
	(compress       (or (configf:lookup *configdat* "archive" "compress") "9"))
        (archiver       (let ((s (configf:lookup *configdat* "archive" "archiver")))
			   (if s (string->symbol s) 'bup)))
        (rsync-exe (or (configf:lookup *configdat* "archive" "rsync") "rsync"))   
        (print-prefix      "Running: ") 
        (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target-patt run-patt "megatest-db"))
	(archive-dir  (if archive-info (cdr archive-info) #f))
	(archive-id   (if archive-info (car archive-info) -1))
        (home-host (common:get-homehost))
        (archive-time (seconds->std-time-str (current-seconds)))
        (archive-staging-db (conc *toppath* "/logs/archive_" archive-time))
        (tmp-db-path (conc (common:get-db-tmp-area) "/megatest.db"))
        (dbfile             (conc  archive-staging-db "/megatest.db"))) 
        (create-directory archive-staging-db #t)
        (let-values (((pid-val exit-status exit-code) (run-n-wait rsync-exe params: (list "-v" (conc (car home-host) ":"tmp-db-path) archive-staging-db) print-cmd: print-prefix)))
            (if (eq? exit-code 0)   
              (case archiver
	        ((bup) ;; Archive using bup
	          (let* ((bup-init-params  (list "-d" archive-dir "init"))
		         (bup-index-params (list "-d" archive-dir "index" archive-staging-db))
		         (bup-save-params  (list "-d" archive-dir "save" ;; (conc "--strip-path=" linktree)
						     (conc "-" compress) ;; or (conc "--compress=" compress)
						     "-n" (conc tsname "-megatest-db" )
						     (conc "--strip-path=" archive-staging-db ) ;; if we push to the directory do we need this?
						     dbfile)))
                    (if (not (common:file-exists? (conc archive-dir "/HEAD")))
		      (begin
		        ;; replace this with jobrunner stuff enventually
		        (debug:print-info 0 *default-log-port* "Init bup in " archive-dir)
		        (run-n-wait bup-exe params: bup-init-params print-cmd: print-prefix)))
		     (debug:print-info 0 *default-log-port* "Indexing data to be archived")
		     (run-n-wait bup-exe params: bup-index-params print-cmd: print-prefix)
		     (debug:print-info 0 *default-log-port* "Archiving data with bup")
		     (run-n-wait bup-exe params: bup-save-params print-cmd: print-prefix)))
               (else
                   (debug:print-info 0 *default-log-port* "No support for databse archiving with " archiver)))
               (debug:print-error 0 *default-log-port* "There was an error rsyncing tmp database")))))

(define (archive:restore-db archive-path ts)
   (let* ((bup-exe               (or (configf:lookup *configdat* "archive" "bup") "bup"))
         (archive-internal-path (conc (common:get-testsuite-name) "-megatest-db/" ts "/megatest.db" ))
         (bup-restore-params  (list "-d" archive-path "restore" "-C" *toppath* archive-internal-path)))
		 (debug:print-info 0 *default-log-port* "Restoring archived data to " *toppath* " from archive in " archive-path " ... " archive-internal-path)
		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f))
      (db:multi-db-sync 
       (db:setup #f)
       'killservers
       ;'dejunk
       ;'adj-testids
       'old2new
       )
      (debug:print-info 1 *default-log-port* "dropping trigerrs to update linktree")   
      (rmt:drop-all-triggers)
  
    (let* ((linktree       (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree")))
	  (src-archive-linktree (rmt:get-var "src-archive-linktree")))
        (if (not (equal? src-archive-linktree linktree))
           (rmt:update-tesdata-on-repilcate-db src-archive-linktree linktree))
              (debug:print-info 1 *default-log-port* "creating triggers after updating linktree")   
       (rmt:create-all-triggers)
))  

(define (archive:ls->list  bup-exe archive-dir internal-path)
  (let ((cmd (conc bup-exe " -d " archive-dir  " ls -l " internal-path "| awk '{print $6}' | sort"))
        (res '()))
    (handle-exceptions
     exn
     #f ;; anything goes wrong - assume the process in NOT running.
     (with-input-from-pipe 
      cmd
      (lambda ()
	(let* ((inl (read-lines)))
	  (reverse inl)))))))

(define (time-string->seconds tstr ds-flag)
 (let* ((atime (string->time tstr "%Y-%m-%d-%H%M%S")))
       (vector-set! atime 8 ds-flag)
     (local-time->seconds atime)))

(define (seconds->std-time-str sec)
  (time->string 
   (seconds->local-time sec)
   "%Y-%m-%d-%H%M%S"))
 

(define (archive:get-timestamp-dir bup-exe archive-dir testsuite-name run-id test-partial-path test-last-update)
    (print (seconds->std-time-str test-last-update)) 
    (let* ((internal-path (conc testsuite-name "-" run-id))
           (ts-list (archive:ls->list  bup-exe archive-dir internal-path))
           (ds-flag (vector-ref (seconds->local-time) 8)))
           (let loop ((hed (car ts-list))
                       (tail (cdr ts-list)))
                   (if (and (null? tail) (equal? hed "latest"))
                        #f
                    (if (and (not (null? tail)) (equal? hed "latest"))
                        (loop (car tail) (cdr tail))
                  (let* ((archive-seconds (time-string->seconds hed ds-flag)))
                    (if (< (abs (- archive-seconds test-last-update)) 120)
                    (let* ((test-list (archive:ls->list  bup-exe archive-dir (conc internal-path "/" hed "/" test-partial-path))))
                           (if (> (length test-list) 0)
                               hed
                               (if (not (null? tail)) 
                                 (loop (car tail) (cdr tail))
                                 #f)))
                       (if (null? tail)
                          #f
                          (loop (car tail) (cdr tail))))))))))

(define (archive:bup-restore archive-command run-id run-name tests rp-mutex bup-mutex)  ;; move the getting of archive space down into the below block so that a single run can 
  ;; allocate as needed should a disk fill up
  ;;
  (let* ((bup-exe      (or (configf:lookup *configdat* "archive" "bup") "bup"))
	 (linktree     (common:get-linktree))) ;; (configf:lookup *configdat* "setup" "linktree")))

    ;; from the test info bin the path to the test by stem
︙
349
350
351
352
353
354
355

356
357
358
359

360

361
362
363
364



365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399

400
401
402
403
404

405
406
407
408
409
410
411

466
467
468
469
470
471
472
473
474
475
476
477
478

479
480
481
482

483
484
485
486

487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502

503
504
505

506

507
508
509
510
511
512
513
514
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529








+




+
-
+



-
+
+
+

-
















-



-

-










+




-
+








	      (prev-test-physical-path (if (common:file-exists? test-path)
					   ;; (read-symbolic-link test-path #t)
					   (common:real-path test-path)
					   #f))
	      (mutex-unlock! rp-mutex)
	      (new-test-physical-path  (conc best-disk "/" test-partial-path))
	      (archive-block-id        (db:test-get-archived test-dat))
              (test-last-update        (db:test-get-last_update test-dat))
	      (archive-block-info      (rmt:test-get-archive-block-info archive-block-id))
	      (archive-path            (if (vector? archive-block-info)
					   (vector-ref archive-block-info 2) ;; look in db.scm for test-get-archive-block-info for the vector record info
					   #f)) ;; no archive found?
              (archive-timestamp-dir   (if archive-path (archive:get-timestamp-dir bup-exe archive-path (common:get-testsuite-name) run-id test-partial-path test-last-update) #f))  
	      (archive-internal-path   (conc (common:get-testsuite-name) "-" run-id "/latest/" test-partial-path))
	      (archive-internal-path   (conc (common:get-testsuite-name) "-" run-id "/" archive-timestamp-dir "/" test-partial-path))
	      (include-paths           (args:get-arg "-include"))
	      (exclude-pattern         (args:get-arg "-exclude-rx"))
	      (exclude-file            (args:get-arg "-exclude-rx-from")))
	 
	 (if (not archive-timestamp-dir)
               (debug:print-error 0 *default-log-port* "Archive not found for testsuite" (common:get-testsuite-name) " run/test/itempath" test-partial-path)
         (begin    
	 ;; some sanity checks, move an existing path out of the way - iif it is not a toplevel with children
	 ;;
	 (if (and (not toplevel/children)  ;; special handling needed for toplevel with children
		  prev-test-physical-path
		  (common:file-exists? prev-test-physical-path)) ;; what to do? abort or clean up or link it in?
	     (let* ((base (pathname-directory prev-test-physical-path))
		    (dirn (pathname-file      prev-test-physical-path))
		    (newn (conc base "/." dirn)))
	       (debug:print-error 0 *default-log-port* "the old directory " prev-test-physical-path ", still exists! Moving it to " newn)
	       (rename-file prev-test-physical-path newn)))

	 (if (and archive-path ;; no point in proceeding if there is no actual archive
		  (not toplevel/children))
	     (begin
	       ;; CREATE WORK AREA
	       ;; test-src-path == #f     ==> don't copy in data from tests directory
	       ;; itemdat       == string ==> use directly
	       (create-work-area run-id run-name keyvals test-id #f best-disk test-name item-path) ;; #!key (remtries 2))

	       ;; 1. Get the block id from the test info
	       ;; 2. Get the block data given the block id
	       ;; 3. Construct the paths etc. for the following command:
	       ;; 
	       ;; bup -d /tmp/matt/adisk1/2015_q1/fullrun_e1a40/ restore -C /tmp/seeme fullrun-30/latest/ubuntu/nfs/none/w02.1.20.54_b/

	       ;; DO BUP RESTORE
	       (let* ((new-test-dat        (rmt:get-test-info-by-id run-id test-id))
		      (new-test-path       (if (vector? new-test-dat )
					       (db:test-get-rundir new-test-dat)
					       (begin
						 (debug:print-error 0 *default-log-port* "unable to get data for run-id=" run-id ", test-id=" test-id)
						 (exit 1))))
		      ;; new-test-path won't work - must use best-disk instead? Nope, new-test-path but tack on /..
		      (bup-restore-params  (list "-d" archive-path "restore" "-C" (conc new-test-path "/..") archive-internal-path)))
		 (debug:print-info 0 *default-log-port* "Restoring archived data to " new-test-physical-path " from archive in " archive-path " ... " archive-internal-path)
                 (debug:print-info 0 *default-log-port* bup-exe " " (string-join  bup-restore-params " "))
		 ;; (mutex-lock! bup-mutex)
		 (run-n-wait bup-exe params: bup-restore-params print-cmd: #f)
		 ;; (mutex-unlock! bup-mutex)
		 (mt:test-set-state-status-by-id run-id test-id "COMPLETED" #f #f)))
	     (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id))))
	     (debug:print-error 0 *default-log-port* "No archive path in the record for run-id=" run-id " test-id=" test-id))))))
     (filter vector? tests))))

(define (common:get-youngest-test tests)
  (if (null? tests)
      #f
      (let ((res #f))
	(for-each
︙

Modified db.scm from [c3242e998a] to [12b84ccd5d].

︙
564
565
566
567
568
569
570
















571
572
573
574
575
576
577

564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








	   '("fieldtype" #f))
     (list "metadat" '("var" #f) '("val" #f))
     (append (list "runs" 
		   '("id"  #f))
	     (map (lambda (k)(list k #f))
		  (append keys
			  (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour" "last_update"))))
     (list "archive_disks"
           '("id" #f)
           '("archive_area_name" #f) 
           '("disk_path" #f)
           '("last_df" #f)
           '("last_df_time" #f)
           '("creation_time" #f)) 

     (list "archive_blocks"
           '("id" #f)
           '("archive_disk_id" #f) 
           '("disk_path" #f)
           '("last_du" #f)
           '("last_du_time" #f)
           '("creation_time" #f)) 

     (list "test_meta"
	   '("id"             #f)
	   '("testname"       #f)
	   '("owner"          #f)
	   '("description"    #f)
	   '("reviewed"       #f)
	   '("iterated"       #f)
︙
718
719
720
721
722
723
724

725
726
727
728
729
730
731
732
733
734
735


736
737

738
739
740
741
742
743
744

734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751

752
753
754

755
756
757
758
759
760
761
762








+










-
+
+

-
+








     (let ((stmts       (make-hash-table)) ;; table-field => stmt
	   (all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	   (numrecs     (make-hash-table))
	   (start-time  (current-milliseconds))
	   (tot-count   0))
       (for-each ;; table
	(lambda (tabledat)
             
	  (let* ((tablename        (car tabledat))
		 (fields           (cdr tabledat))
		 (has-last-update  (member "last_update" fields))
		 (use-last-update  (cond
				    ((and has-last-update
					  (member "last_update" fields))
				     #t) ;; if given a number, just use it for all fields
				    ((number? last-update) #f) ;; if not matched first entry then ignore last-update for this table
				    ((and (pair? last-update)
					  (member (car last-update)    ;; last-update field name
						  (map car fields))) #t)
						  (map car fields)))
                                        #t)
				    (last-update
				     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update) ;; found in fields
				     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair or a number, received: " last-update);; found in fields
				     #f)
				    (else
				     #f)))
		 (last-update-value (if use-last-update ;; no need to check for has-last-update - it is already accounted for
					(if (number? last-update)
					    last-update
					    (cdr last-update))
︙
760
761
762
763
764
765
766
767

768
769
770
771
772
773
774

778
779
780
781
782
783
784

785
786
787
788
789
790
791
792








-
+








				   " VALUES ( " (string-intersperse (make-list num-fields "?") ",") " );"))
		 (fromdat    '())
		 (fromdats   '())
		 (totrecords 0)
		 (batch-len  (string->number (or (configf:lookup *configdat* "sync" "batchsize") "100")))
		 (todat      (make-hash-table))
		 (count      0)

                 (field-names (map car fields))
                 (delay-handicap  (string->number (or (configf:lookup *configdat* "sync" "delay-handicap") "0")))
                 )

	    ;; set up the field->num table
	    (for-each
	     (lambda (field)
	       (hash-table-set! field->num field count)
︙
806
807
808
809
810
811
812

813





814
815


816
817
818
819
820
821
822

824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848








+

+
+
+
+
+


+
+








              (thread-sleep! delay-handicap)
              (debug:print-info 0 *default-log-port* "synthetic sync delay of "delay-handicap" seconds completed")
              )
            
	    ;; first pass implementation, just insert all changed rows
	    (for-each 
	     (lambda (targdb)
               ;(print targdb " " tablename)
	       (let* ((db     (db:dbdat-get-db targdb))
                      (drp-trigger (if (member "last_update" field-names)
                                      (db:drop-trigger db tablename) 
                                       #f))
                       (is-trigger-dropped (if (member "last_update" field-names)
                                              (db:is-trigger-dropped db tablename) #f)) 
		      (stmth  (sqlite3:prepare db full-ins)))
		 (db:delay-if-busy targdb) ;; NO WAITING
                (if (member "last_update" field-names)
                  (debug:print-info 3 *default-log-port* "is-trigger-dropped: " is-trigger-dropped)) 
		 (for-each
		  (lambda (fromdat-lst)
		    (sqlite3:with-transaction
		     db
		     (lambda ()
		       (for-each ;; 
			(lambda (fromrow)
︙
830
831
832
833
834
835
836
837

838
839
840



841
842
843
844
845
846
847

856
857
858
859
860
861
862

863

864

865
866
867
868
869
870
871
872
873
874








-
+
-

-
+
+
+








			      (if (and same
				       (< i (- num-fields 1)))
				  (loop (+ i 1))))
			    (if (not same)
				(begin
				  (apply sqlite3:execute stmth (vector->list fromrow))
				  (hash-table-set! numrecs tablename (+ 1 (hash-table-ref/default numrecs tablename 0)))))))
			fromdat-lst))
			fromdat-lst))))
		  ))
		  fromdats)
		 (sqlite3:finalize! stmth)))
		 (sqlite3:finalize! stmth)
                 (if (member "last_update" field-names)
                    (db:create-trigger db tablename))))
	     (append (list todb) slave-dbs))))
	tbls)
       (let* ((runtime      (- (current-milliseconds) start-time))
	      (should-print (or (debug:debug-mode 12)
				(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
	 (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
	 (for-each
︙
1188
1189
1190
1191
1192
1193
1194





















































































1195
1196
1197
1198
1199
1200
1201

1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








   (apply open-run-close-no-exception-handling proc idb params)))

;; (define open-run-close 
#;(define open-run-close open-run-close-exception-handling)
		;;	   open-run-close-no-exception-handling
;;			   open-run-close-exception-handling)
;;)

(define db:trigger-list 
     (list (list "update_runs_trigger"  "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE runs SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;" ) 
       (list "update_run_stats_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;" )
       (list "update_tests_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE tests SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;" )
       (list "update_teststeps_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE test_steps SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;" )
       (list "update_test_data_trigger"  "CREATE TRIGGER  IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE test_data SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;" )))

(define (db:create-all-triggers dbstruct)
(db:with-db
   dbstruct #f #f
   (lambda (db)
(db:create-triggers db))))

(define (db:create-triggers db)
    (for-each (lambda (key)
              (sqlite3:execute db (cadr key)))
          db:trigger-list))

(define (db:drop-all-triggers dbstruct)
(db:with-db
   dbstruct #f #f
   (lambda (db)
(db:drop-triggers db))))

(define (db:is-trigger-dropped db tbl-name)
     (let* ((trigger-name (if (equal? tbl-name "test_steps")
				"update_teststeps_trigger" 
                                (conc "update_" tbl-name "_trigger"))))
            (sqlite3:for-each-row
		   (lambda (name)
                     ;(print name)
		     (set! res (vector name)))
		   db 
		   "select name  from sqlite_master where type = 'trigger' ;" 
		   )))

(define (db:drop-triggers db)
  (for-each (lambda (key) 
              (sqlite3:execute db (conc "drop trigger " (car key))))
          db:trigger-list))

(define  (db:drop-trigger db tbl-name)
      (let* ((trigger-name (if (equal? tbl-name "test_steps")
				"update_teststeps_trigger" 
                                (conc "update_" tbl-name "_trigger"))))
       (for-each (lambda (key) 
             (if (equal? (car key) trigger-name)
             (sqlite3:execute db (conc "drop trigger " trigger-name))))
      db:trigger-list)))

(define  (db:create-trigger db tbl-name)
      (let* ((trigger-name (if (equal? tbl-name "test_steps")
                              "update_teststeps_trigger" 
                              (conc "update_" tbl-name "_trigger"))))
       (for-each (lambda (key) 
             (if (equal? (car key) trigger-name)
             (sqlite3:execute db (cadr key))))
      db:trigger-list))) 


(define (db:initialize-main-db dbdat)
  (when (not *configinfo*)
           (launch:setup)) ;; added because Elena was getting stack dump because *configinfo* below was #f.
  (let* ((configdat (car *configinfo*))  ;; tut tut, global warning...
	 (keys     (keys:config-get-fields configdat))
	 (havekeys (> (length keys) 0))
︙
1233
1234
1235
1236
1237
1238
1239

1240
1241
1242
1243
1244
1245






1246
1247
1248
1249
1250
1251
1252

1253
1254
1255
1256
1257
1258






1259
1260
1261
1262
1263
1264
1265

1345
1346
1347
1348
1349
1350
1351
1352






1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366






1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379








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







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








			 owner      TEXT DEFAULT '',
			 event_time TIMESTAMP DEFAULT (strftime('%s','now')),
			 comment    TEXT DEFAULT '',
			 fail_count INTEGER DEFAULT 0,
			 pass_count INTEGER DEFAULT 0,
                         last_update INTEGER DEFAULT (strftime('%s','now')),
			 CONSTRAINT runsconstraint UNIQUE (runname" (if havekeys "," "") keystr "));"))
        ;; All triggers created at once in end
	(sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE runs SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;")
	;;(sqlite3:execute db "CREATE TRIGGER IF NOT EXISTS update_runs_trigger AFTER UPDATE ON runs
        ;;                    FOR EACH ROW
        ;;                       BEGIN 
        ;;                         UPDATE runs SET last_update=(strftime('%s','now'))
        ;;                           WHERE id=old.id;
        ;;                       END;")
	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS run_stats (
                              id     INTEGER PRIMARY KEY,
                              run_id INTEGER,
                              state  TEXT,
                              status TEXT,
                              count  INTEGER,
                              last_update INTEGER DEFAULT (strftime('%s','now')))")
         ;; All triggers created at once in end
	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;")
         ;; (sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
         ;;                   FOR EACH ROW
         ;;                     BEGIN 
         ;;                       UPDATE run_stats SET last_update=(strftime('%s','now'))
         ;;                         WHERE id=old.id;
         ;;                      END;")
	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (
                                     id          INTEGER PRIMARY KEY,
                                     testname    TEXT DEFAULT '',
                                     author      TEXT DEFAULT '',
                                     owner       TEXT DEFAULT '',
                                     description TEXT DEFAULT '',
                                     reviewed    TIMESTAMP,
︙
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364








1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376

1377
1378
1379
1380
1381
1382






1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396

1397
1398
1399
1400
1401
1402






1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418


1419
1420
1421
1422
1423
1424
1425

1465
1466
1467
1468
1469
1470
1471







1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492






1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513






1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544








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












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














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
















+
+








                     last_update  INTEGER DEFAULT (strftime('%s','now')),
                        CONSTRAINT testsconstraint UNIQUE (run_id, testname, item_path));")
	;; deprecated -- (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_index ON tests (run_id, testname, item_path, uname);")
        
        (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_run_id_index ON tests (run_id);")  ;; new
        (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_testname_index ON tests (testname,item_path);") ;; new
        (sqlite3:execute db "CREATE INDEX IF NOT EXISTS tests_state_status_index ON tests (state, status); ") ;; new
        
	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE tests SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;")

         ;; All triggers created at once in end
	;;(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_tests_trigger AFTER UPDATE ON tests
        ;;                     FOR EACH ROW
        ;;                       BEGIN 
        ;;                         UPDATE tests SET last_update=(strftime('%s','now'))
        ;;                           WHERE id=old.id;
        ;;                       END;")
	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_steps 
                              (id INTEGER PRIMARY KEY,
                               test_id INTEGER, 
                               stepname TEXT, 
                               state TEXT DEFAULT 'NOT_STARTED', 
                               status TEXT DEFAULT 'n/a',
                               event_time TIMESTAMP,
                               comment TEXT DEFAULT '',
                               logfile TEXT DEFAULT '',
                               last_update  INTEGER DEFAULT (strftime('%s','now')),
                               CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));")
	(sqlite3:execute db "CREATE INDEX IF NOT EXISTS teststeps_index ON tests (run_id, testname, item_path);")
        ;; All triggers created at once in end
	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE test_steps SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;")
	;;(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_teststeps_trigger AFTER UPDATE ON test_steps
        ;;                     FOR EACH ROW
        ;;                       BEGIN 
        ;;                         UPDATE test_steps SET last_update=(strftime('%s','now'))
        ;;                           WHERE id=old.id;
        ;;                       END;")
	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
                                test_id INTEGER,
                                category TEXT DEFAULT '',
                                variable TEXT,
	                        value REAL,
	                        expected REAL,
	                        tol REAL,
                                units TEXT,
                                comment TEXT DEFAULT '',
                                status TEXT DEFAULT 'n/a',
                                type TEXT DEFAULT '',
                                last_update  INTEGER DEFAULT (strftime('%s','now')),
                              CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));")
	(sqlite3:execute db "CREATE INDEX IF NOT EXISTS test_data_index ON test_data (test_id);")
        ;; All triggers created at once in end
	(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE test_data SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;")
	;;(sqlite3:execute db "CREATE TRIGGER  IF NOT EXISTS update_test_data_trigger AFTER UPDATE ON test_data
        ;;                     FOR EACH ROW
        ;;                       BEGIN 
        ;;                         UPDATE test_data SET last_update=(strftime('%s','now'))
        ;;                           WHERE id=old.id;
        ;;                       END;")
	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_rundat (
                              id           INTEGER PRIMARY KEY,
                              test_id      INTEGER,
                              update_time  TIMESTAMP,
                              cpuload      INTEGER DEFAULT -1,
                              diskfree     INTEGER DEFAULT -1,
                              diskusage    INTGER DEFAULT -1,
                              run_duration INTEGER DEFAULT 0);")
	(sqlite3:execute db "CREATE TABLE IF NOT EXISTS archives (
                              id           INTEGER PRIMARY KEY,
                              test_id      INTEGER,
                              state        TEXT DEFAULT 'new',
                              status       TEXT DEFAULT 'n/a',
                              archive_type TEXT DEFAULT 'bup',
                              du           INTEGER,
                              archive_path TEXT);")))
         (print "creating trigges from init") 
        (db:create-triggers db)    
     db)) ;; )

;;======================================================================
;; A R C H I V E S
;;======================================================================

;; dneeded is minimum space needed, scan for existing archives that
︙
3246
3247
3248
3249
3250
3251
3252






3253
3254
3255
3256
3257
3258
3259

3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384








+
+
+
+
+
+








	    indx
	    (if (null? tal)
		#f
		(loop (car tal)(cdr tal)(+ indx 1)))))))

(define db:test-record-qry-selector (string-intersperse db:test-record-fields ","))

(define (db:update-tesdata-on-repilcate-db dbstruct old-lt new-lt)
  (db:with-db
   dbstruct   #f   #f
   (lambda (db)
     (sqlite3:execute db "UPDATE tests SET rundir= replace(rundir,?,?), shortdir=replace(shortdir,?,?);"
		      old-lt new-lt  old-lt new-lt))))

;; NOTE: Use db:test-get* to access records
;; NOTE: This needs rundir decoding? Decide, decode here or where used? For the moment decode where used.
(define (db:get-all-tests-info-by-run-id dbstruct run-id)
  (let* ((res '()))
    (db:with-db
     dbstruct #f #f
︙

Modified megatest.scm from [5f0ce788d2] to [5f03716a04].

︙
224
225
226
227
228
229
230
231

232
233
234
235
236
237
238

224
225
226
227
228
229
230

231
232
233
234
235
236
237
238








-
+








  -refdb2dat refdb        : convert refdb to sexp or to format specified by s-dumpmode
                            formats: perl, ruby, sqlite3, csv (for csv the -o param
                            will substitute %s for the sheet name in generating 
                            multiple sheets)
  -o                      : output file for refdb2dat (defaults to stdout)
  -archive cmd            : archive runs specified by selectors to one of disks specified
                            in the [archive-disks] section.
                            cmd: keep-html, restore, save, save-remove, get (use 
                            cmd: keep-html, restore, save, save-remove, get,replicate-db (use 
                            -dest to set destination), -include path1,path2... to get or save specific files
  -generate-html          : create a simple html dashboard for browsing your runs
  -generate-html-structure  : create a top level html veiw to list targets/runs and a Run view within each run directory.  
  -list-run-time          : list time requered to complete runs. It supports following switches
                            -run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
  -list-test-time	   : list time requered to complete each test in a run. It following following arguments
                            -runname <patt> -target <patt> -dumpmode <csv,json,plain-text>
︙
299
300
301
302
303
304
305


306
307
308
309
310
311
312

299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314








+
+








			"-m"
			"-rerun"

			"-days"
			"-rename-run"
			"-to"
			"-dest"
                        "-source" 
                        "-time-stamp" 
			;; values and messages
			":category"
			":variable"
			":value"
			":expected"
			":tol"
			":units"
︙
1911
1912
1913
1914
1915
1916
1917
1918






























1919

1920
1921
1922
1923
1924
1925
1926

1913
1914
1915
1916
1917
1918
1919

1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958








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

+








			 (print path))
		       paths))))))

;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
(if (equal? (args:get-arg "-archive") "replicacte-db")
    (begin
          ;; check if source
          ;; check if megatest.db exist 
         (launch:setup)   
         (if (not (args:get-arg "-source"))
             (begin 
             (debug:print-info 1 *default-log-port* "Missing required argument -source <archive path>")
             (exit 1)))
         (if (common:file-exists? (conc  *toppath* "/megatest.db"))
             (begin  
               (debug:print-info 1 *default-log-port* "File " (conc  *toppath* "/megatest.db") " already exists. Please remove it before trying to replicate db")
               (exit 1)))
         (if (and (common:get-db-tmp-area) (> (length (directory   (common:get-db-tmp-area) #f)) 0))
           (begin
           (debug:print-info 1 *default-log-port* (common:get-db-tmp-area) " not empty. Please remove it before trying to replicate db")
           (exit 1)))    
          ;; check if timestamp 
          (let* ((source (args:get-arg "-source"))
                (src     (if (not (equal? (substring source 0 1) "/"))
                             (conc (current-directory) "/" source)
                             source))
                (ts (if (args:get-arg "-time-stamp")   (args:get-arg "-time-stamp") "latest")))
              (if  (common:directory-exists? src)
                  (begin 
                  (archive:restore-db src ts)
            (set! *didsomething* #t))
       (begin
         (debug:print-error 1 *default-log-port* "Path " source " not found")
         (exit 1))))))   
    ;; else do a general-run-call
   (if (and (args:get-arg "-archive") (not (equal? (args:get-arg "-archive") "replicacte-db"))) 
    (begin
      ;; for the archive get we need to preserve the starting dir as part of the target path
      (if (and (args:get-arg "-dest")
	       (not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
	  (let ((newpath  (conc (current-directory) "/" (args:get-arg "-dest"))))
	    (debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath)
	    (hash-table-set! args:arg-hash "-dest" newpath)))
︙

Modified rmt.scm from [54042a29d0] to [03bc9d9a92].

︙
491
492
493
494
495
496
497






498
499
500
501
502
503
504

491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510








+
+
+
+
+
+









(define (rmt:get-run-record-ids  target run keynames test-patt)
  (rmt:send-receive 'get-run-record-ids #f (list target run keynames test-patt)))

(define (rmt:get-changed-record-ids since-time)
  (rmt:send-receive 'get-changed-record-ids #f (list since-time)) )

(define (rmt:drop-all-triggers)
     (rmt:send-receive 'drop-all-triggers #f '()))

(define (rmt:create-all-triggers)
     (rmt:send-receive 'create-all-triggers #f '()))

;;======================================================================
;;  T E S T   M E T A 
;;======================================================================

(define (rmt:get-tests-tags)
  (rmt:send-receive 'get-tests-tags #f '()))
︙
786
787
788
789
790
791
792



793
794
795
796
797
798
799

792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808








+
+
+









(define (rmt:set-run-status run-id run-status #!key (msg #f))
  (rmt:send-receive 'set-run-status #f (list run-id run-status msg)))

(define (rmt:set-run-state-status run-id state status )
  (rmt:send-receive 'set-run-state-status #f (list run-id state status)))

(define (rmt:update-tesdata-on-repilcate-db old-lt new-lt)
(rmt:send-receive 'update-tesdata-on-repilcate-db #f (list old-lt new-lt)))

(define (rmt:update-run-event_time run-id)
  (rmt:send-receive 'update-run-event_time #f (list run-id)))

(define (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit fields last-runs-update  #!key  (sort-order "asc")) ;; fields of #f uses default
  (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update sort-order)))

(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
︙

Modified runs.scm from [4d33de1e71] to [eb3b96455d].

︙
2766
2767
2768
2769
2770
2771
2772





2773
2774
2775
2776
2777
2778
2779

2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784








+
+
+
+
+








                   )
		       )))))
	 ))
     runs)
    ;; special case - archive get
    (if (equal? (args:get-arg "-archive") "get")
	(archive:bup-get-data "get" #f #f test-records rp-mutex bup-mutex))
    (if (or (equal? (args:get-arg "-archive") "save") (equal? (args:get-arg "-archive") "save-remove"))
        (begin 
             (print "db archive started")  
             (archive:megatest-db target runnamepatt)
             (print "db archived")))
    )
  #t
  )

(define (runs:remove-test-directory test mode) ;; remove-data-only)
  (let* ((run-dir       (db:test-get-rundir test))    ;; run dir is from the link tree
	 (real-dir      (if (common:file-exists? run-dir)
︙

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