summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2012-01-31 20:04:40 +0100
committerPeter Bex <peter@more-magic.net>2012-01-31 20:04:40 +0100
commitd1fdca00933d07a81debf6631bb55a6074458222 (patch)
treee23c6112f89847284160d2f58265b155a313da5c
parent40dc846436e0251aeaff4570e68c5889ac6ea387 (diff)
parentf7608301daf1af4b39a11051829eabc6d5685df9 (diff)
downloadhenrietta-cache-d1fdca00933d07a81debf6631bb55a6074458222.tar.gz
Merged in DerGuteMoritz/henrietta-cache (pull request #3)
-rw-r--r--henrietta-cache.scm19
1 files changed, 14 insertions, 5 deletions
diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index f7914fe..8f63bba 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -1,4 +1,4 @@
-(use utils posix http-client matchable uri-common srfi-1)
+(use utils posix http-client matchable uri-common srfi-1 chicken-syntax)
(define (usage code)
(print #<#EOF
@@ -8,6 +8,7 @@ usage: henrietta-cache [OPTION ...]
-c -cache-dir CACHEDIR put egg cache in this dir, defaults to "cache"
-e -egg-list EGGLIST file containing the master list of available
eggs, defaults to "egg-locations". Can be an URI
+ -i -init-file INITFILE a file to load before starting the process
Henrietta-cache will download cached copies of each egg listed in the file
EGGLIST, to CACHEDIR.
@@ -26,9 +27,13 @@ EOF
(define download-release-error-hook
(make-parameter #f))
+(define read-release-info-file-error-hook
+ (make-parameter #f))
+
(define hooks
`((download-release-success . ,download-release-success-hook)
- (download-release-error . ,download-release-error-hook)))
+ (download-release-error . ,download-release-error-hook)
+ (read-release-info-file-error . ,read-release-info-file-error-hook)))
(define (run-hook hook-name . args)
(and-let* ((hook (or (alist-ref hook-name hooks)
@@ -199,7 +204,10 @@ EOF
egg-name egg-release)
(print-error-message exn (current-error-port))
(flush-output (current-error-port))
- (run-hook 'download-release-error egg-name egg-release))
+ (run-hook 'download-release-error
+ egg-name
+ egg-release
+ (get-condition-property exn 'exn 'message)))
(create-directory cache-dir #t)
(download-release type uri cache-dir)
(run-hook 'download-release-success egg-name egg-release))))))
@@ -211,10 +219,11 @@ EOF
(define (read-release-info-file uri egg-name)
(handle-exceptions exn
- (begin
+ (let ((message (get-condition-property exn 'exn 'message)))
(fprintf (current-error-port)
"Could not fetch release-info file for egg ~A from ~A -- ~A\n"
- egg-name uri (get-condition-property exn 'exn 'message))
+ egg-name uri message)
+ (run-hook 'read-release-info-file-error egg-name uri message)
(flush-output (current-error-port))
'())
(with-input-from-request uri #f read-file)))