summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2011-03-20 20:09:33 +0100
committerPeter Bex <peter@more-magic.net>2011-03-20 20:09:33 +0100
commit24ffacf4b7df4f572a4c51ca6d87d120d24a17d2 (patch)
tree51a0b19be34adb1506d7d227fd44a4b188783f04
parent0b8bffe234dde019f459777d0a5eb3ea99b32601 (diff)
downloadhenrietta-cache-24ffacf4b7df4f572a4c51ca6d87d120d24a17d2.tar.gz
Add handling for meta-files
-rw-r--r--henrietta-cache.scm28
1 files changed, 27 insertions, 1 deletions
diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index 05d1925..affbb02 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -78,7 +78,33 @@ EOF
(make-pathname tmpdir (car contents))
tmpdir)))
(rename-file contents-dir cache-dir)
- (system (sprintf "rm -rf ~A" (qs tmpdir)))))))))
+ (system (sprintf "rm -rf ~A" (qs tmpdir)))))))
+ (meta-file . ,(lambda (uri cache-dir)
+ (let* ((meta (car (call-with-input-request uri #f read-file)))
+ (uri (uri-reference uri))
+ (add-to-uri
+ (lambda (f)
+ (let ((rel (update-uri (uri-reference "")
+ path: (string-split f "/"))))
+ (uri-relative-to rel uri))))
+ (files (alist-ref 'files meta)))
+ (unless files
+ (error "No \"files\" entry found in meta file" uri))
+ (for-each
+ (lambda (file)
+ (printf "\t\t~A...\n" file)
+ (flush-output)
+ (and-let* ((dirname (pathname-directory file))
+ (directory (make-pathname cache-dir dirname)))
+ (unless (file-exists? directory)
+ (create-directory directory #t)))
+ (call-with-input-request
+ (add-to-uri file) #f
+ (lambda (i)
+ (call-with-output-file
+ (make-pathname cache-dir file)
+ (lambda (o) (copy-port i o))))))
+ files))))))
(define (download-all-release-files egg-name uris/releases uris)
(let ((egg-cache-dir (make-pathname *cache-directory* (->string egg-name))))