Megatest

Check-in [ff44bdeb52]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Archiving fixes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: ff44bdeb520aca07153a5b1f1e3e818eae2be064
User & Date: mrwellan on 2014-12-11 10:15:59
Other Links: branch diff | manifest | tags
Context
2014-12-11
12:11
Minor tweaks to archiving check-in: 7ef1619f04 user: mrwellan tags: v1.60
10:15
Archiving fixes check-in: ff44bdeb52 user: mrwellan tags: v1.60
00:18
Basic archiving done check-in: aa5d0defe7 user: matt tags: v1.60
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified archive.scm from [be69266199] to [7f7ca3e33d].

︙︙
92
93
94
95
96
97
98

99
100
101
102
103
104
105

;; 1. create the bup dir if not exists
;; 2. start the du of each directory
;; 3. gen index
;; 4. save
;;
(define (archive:run-bup archive-dir run-id run-name tests)
  (let* ((bup-exe    (or (configf:lookup *configdat* "archive" "bup") "bup"))

	 (linktree   (configf:lookup *configdat* "setup" "linktree"))
	 (test-paths (filter
		      string?
		      (map (lambda (test-dat)
			     (let* ((item-path         (db:test-get-item-path test-dat))
				    (test-name         (db:test-get-testname  test-dat))
				    (run-id            (db:test-get-run_id    test-dat))








>








92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

;; 1. create the bup dir if not exists
;; 2. start the du of each directory
;; 3. gen index
;; 4. save
;;
(define (archive:run-bup archive-dir run-id run-name tests)
  (let* ((bup-exe    (or (configf:lookup *configdat* "archive" "bup") "bup"))
	 (compress   (or (configf:lookup *configdat* "archive" "compress") "9"))
	 (linktree   (configf:lookup *configdat* "setup" "linktree"))
	 (test-paths (filter
		      string?
		      (map (lambda (test-dat)
			     (let* ((item-path         (db:test-get-item-path test-dat))
				    (test-name         (db:test-get-testname  test-dat))
				    (run-id            (db:test-get-run_id    test-dat))
︙︙
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

				       (not (file-exists? test-path)))
				   #f
				   test-path)))
			   tests)))
	 ;; ((string-intersperse (map cadr (rmt:get-key-val-pairs 1)) "-")
	 (bup-init-params  (list "-d" archive-dir "init"))
	 (bup-index-params (append (list "-d" archive-dir "index") test-paths))
	 (bup-save-params  (append (list "-d" archive-dir "save" "--strip-path" linktree "-n" 
					 (conc (common:get-testsuite-name) "-" run-id))
				   test-paths)))
    (if (not (file-exists? archive-dir))
	(create-directory archive-dir #t))
    (if (not (file-exists? (conc archive-dir "/HEAD")))
	(begin
	  ;; replace this with jobrunner stuff enventually
	  (debug:print-info 0 "Init bup in " archive-dir)
	  (run-n-wait bup-exe params: bup-init-params)))
    (debug:print-info 0 "Indexing data to be archived")
    (run-n-wait bup-exe params: bup-index-params)
    (debug:print-info 0 "Archiving data with bup")
    (run-n-wait bup-exe params: bup-save-params)
    #t))








|








|

|

|


114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

				       (not (file-exists? test-path)))
				   #f
				   test-path)))
			   tests)))
	 ;; ((string-intersperse (map cadr (rmt:get-key-val-pairs 1)) "-")
	 (bup-init-params  (list "-d" archive-dir "init"))
	 (bup-index-params (append (list "-d" archive-dir "index") test-paths))
	 (bup-save-params  (append (list "-d" archive-dir "save" (conc "--strip-path=" linktree) "-n" ;; (conc "-" compress) or (conc "--compress=" compress)
					 (conc (common:get-testsuite-name) "-" run-id))
				   test-paths)))
    (if (not (file-exists? archive-dir))
	(create-directory archive-dir #t))
    (if (not (file-exists? (conc archive-dir "/HEAD")))
	(begin
	  ;; replace this with jobrunner stuff enventually
	  (debug:print-info 0 "Init bup in " archive-dir)
	  (run-n-wait bup-exe params: bup-init-params))) ;;  print-cmd: "Running: ")))
    (debug:print-info 0 "Indexing data to be archived")
    (run-n-wait bup-exe params: bup-index-params) ;;  print-cmd: "Running: ")
    (debug:print-info 0 "Archiving data with bup")
    (run-n-wait bup-exe params: bup-save-params) ;;  print-cmd: "Running: ")
    #t))

Modified process.scm from [ef168a2a0a] to [13bb37a3d1].

︙︙
99
100
101
102
103
104
105
106









107
108
109
110
111
112
113

            (loop (let ((l (read-line fh)))
                    (if (eof-object? l) l (proc l)))
                  (append result (list curr)))
            result))))

;; here is an example line where the shell is sh or bash
;; "find / -print 2&>1 > findall.log"
(define (run-n-wait cmdline #!key (params #f))









  (let ((pid (if params
		 (process-run cmdline params)
		 (process-run cmdline))))
    (let loop ((i 0))
      (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
         (if (eq? pid-val 0)
	     (begin








|
>
>
>
>
>
>
>
>
>








99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

            (loop (let ((l (read-line fh)))
                    (if (eof-object? l) l (proc l)))
                  (append result (list curr)))
            result))))

;; here is an example line where the shell is sh or bash
;; "find / -print 2&>1 > findall.log"
(define (run-n-wait cmdline #!key (params #f)(print-cmd #f))
  (if print-cmd 
      (debug:print 0 
		   (if (string? print-cmd)
		       print-cmd
		       "")
		   cmdline
		   (if params
		       (string-intersperse params " ")
		       "")))
  (let ((pid (if params
		 (process-run cmdline params)
		 (process-run cmdline))))
    (let loop ((i 0))
      (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
         (if (eq? pid-val 0)
	     (begin
︙︙

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