diff options
| author | Peter Bex <peter@more-magic.net> | 2011-03-20 20:09:33 +0100 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2011-03-20 20:09:33 +0100 |
| commit | 24ffacf4b7df4f572a4c51ca6d87d120d24a17d2 (patch) | |
| tree | 51a0b19be34adb1506d7d227fd44a4b188783f04 | |
| parent | 0b8bffe234dde019f459777d0a5eb3ea99b32601 (diff) | |
| download | henrietta-cache-24ffacf4b7df4f572a4c51ca6d87d120d24a17d2.tar.gz | |
Add handling for meta-files
| -rw-r--r-- | henrietta-cache.scm | 28 |
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)))) |