Megatest

Diff
Login

Differences From Artifact [fd3e9e2a92]:

To Artifact [9241640f45]:


31
32
33
34
35
36
37















38

39
40
41
42
43
44
45
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
60







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







(declare (uses dbmod))
(declare (uses rmtmod))
(declare (uses launchmod))
(declare (uses processmod))
(declare (uses servermod))

(module archivemod
	   (
archive:get-archive-disks
archive:get-archive
archive:allocate-new-archive-block
archive:run-bup
archive:megatest-db
archive:restore-db
archive:ls->list
time-string->seconds
seconds->std-time-str
archive:get-timestamp-dir
archive:bup-restore
common:get-youngest-test
archive:bup-get-data
)
	*

	
(import scheme
	(prefix sqlite3 sqlite3:)
	chicken.base
	chicken.condition
	chicken.file
	chicken.file.posix
221
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
250







-
+







	 (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"))  
         (src-archive-linktree (rmt:get-var run-id "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)
    
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







-
+







       ;'dejunk
       ;'adj-testids
       'old2new
       )
      (debug:print-info 1 *default-log-port* "dropping triggers 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")))
	  (src-archive-linktree (rmt:get-var #f "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)