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: |
b487e8f3c5ee74eeeaa6edabd92e2548 |
| 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
Modified archive.scm from [228240a5c7] to [09abb4e185].
| ︙ | ︙ | |||
244 245 246 247 248 249 250 |
(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)
| | > > > > > > > > > | 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-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)
|
| ︙ | ︙ |