summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2011-03-20 00:29:27 +0100
committerPeter Bex <peter@more-magic.net>2011-03-20 00:29:27 +0100
commit57ef6c60951aee21943e61ccf9b7d5976b2ffb30 (patch)
tree1cf1202c41464ca62fe200d1d8c83566e034e6d6
parentb419489ff568885b46c06fe2d9d31be07f1e07a8 (diff)
downloadhenrietta-cache-57ef6c60951aee21943e61ccf9b7d5976b2ffb30.tar.gz
Improve status output and don't download when we already have the file
-rw-r--r--henrietta-cache.scm29
1 files changed, 17 insertions, 12 deletions
diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index e8beb01..1e04b92 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -49,18 +49,22 @@ EOF
(uri-template (cadr uri-info)))
(for-each
(lambda (egg-release)
- (let* ((patterns `((egg-name . ,egg-name)
- (egg-release . ,egg-release)
- (chicken-release . ,*chicken-release*)))
- (uri (replace-uri-patterns uri-template patterns)))
- (printf "Downloading egg ~A, release ~A from ~A...\n"
- egg-name egg-release uri)
- ;; Here we should dispatch on type to determine what to do!
- (call-with-input-request
- uri #f (lambda (i)
- (call-with-output-file
- (make-pathname egg-cache-dir egg-release)
- (lambda (o) (copy-port i o)))))))
+ (let ((cached-file (make-pathname egg-cache-dir
+ egg-release
+ (->string type))))
+ (unless (file-exists? cached-file)
+ (let* ((patterns `((egg-name . ,egg-name)
+ (egg-release . ,egg-release)
+ (chicken-release . ,*chicken-release*)))
+ (uri (replace-uri-patterns uri-template patterns)))
+ (printf "\tDownloading release ~A from ~A\n"
+ egg-release uri)
+ ;; Here we should dispatch on type to determine what to do!
+ (call-with-input-request
+ uri #f (lambda (i)
+ (call-with-output-file
+ cached-file
+ (lambda (o) (copy-port i o)))))))))
(cdr uri/releases))))
uris/releases)))
@@ -75,6 +79,7 @@ EOF
(patterns `((egg-name . ,egg-name)
(chicken-release . ,*chicken-release*)))
(uri (replace-uri-patterns egg-uri-template patterns)))
+ (printf "Caching egg '~A'\n" egg-name)
(let collect-releases ((info (with-input-from-request uri #f read-file))
(uris/releases '())
(uris '()))