Megatest

Check-in [b487e8f3c5]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added -inlcude support to save and get for archive
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-broken
Files: files | file ages | folders
SHA1: b487e8f3c5ee74eeeaa6edabd92e2548a33210f7
User & Date: mrwellan on 2020-05-05 11:29:22
Other Links: branch diff | manifest | tags
Context
2020-05-05
11:30
Added -inlcude support to save and get for archive check-in: e28be4def5 user: mrwellan tags: v1.65-broken
11:29
Added -inlcude support to save and get for archive check-in: b487e8f3c5 user: mrwellan tags: v1.65-broken
2020-05-04
22:51
Added -include support for archive get check-in: 63e558983a user: mrwellan tags: v1.65-broken
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified archive.scm from [228240a5c7] to [09abb4e185].

︙
244
245
246
247
248
249
250
251










252
253
254
255
256
257
258

244
245
246
247
248
249
250

251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267








-
+
+
+
+
+
+
+
+
+
+








     (lambda (test-base)
       (let* ((disk-group (hash-table-ref disk-groups test-base))
	      (arch-group (hash-table-ref arch-groups test-base))
	      (arch-info  (car arch-group)) ;; don't know yet how this will work, can I get more than one possibility?
	      (archive-id    (car arch-info))
	      (archive-dir   (cdr arch-info)))
	 (debug:print 0 *default-log-port* "Processing disk-group " test-base)
	 (let* ((test-paths (hash-table-ref disk-groups test-base)))
	 (let* ((test-paths-in (hash-table-ref disk-groups test-base))
		(test-paths    (if (args:get-arg "-include")
				   (let ((subpaths (string-split (args:get-arg "-include") ",")))
				     (apply append
					    (map (lambda (p)
						   (map (lambda (subp)
							  (conc p "/" subp))
							subpaths))
						 test-paths-in)))
				   test-paths-in)))
	   (if (not (common:file-exists? archive-dir))
	       (create-directory archive-dir #t))
	   (case archiver
	     ((bup) ;; Archive using bup
	      (let* ((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)
︙

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