diff options
| author | Peter Bex <peter@more-magic.net> | 2011-03-20 00:29:27 +0100 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2011-03-20 00:29:27 +0100 |
| commit | 57ef6c60951aee21943e61ccf9b7d5976b2ffb30 (patch) | |
| tree | 1cf1202c41464ca62fe200d1d8c83566e034e6d6 | |
| parent | b419489ff568885b46c06fe2d9d31be07f1e07a8 (diff) | |
| download | henrietta-cache-57ef6c60951aee21943e61ccf9b7d5976b2ffb30.tar.gz | |
Improve status output and don't download when we already have the file
| -rw-r--r-- | henrietta-cache.scm | 29 |
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 '())) |