From 28be1ab22290a31de4f4686c95c6f42dd75bed30 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Mon, 15 Sep 2014 19:25:32 +0200 Subject: Do not default to the current CHICKEN release, that's just too confusing (I think). Remove "tags" subdirectories --- henrietta-cache.scm | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/henrietta-cache.scm b/henrietta-cache.scm index e5311b2..9153852 100644 --- a/henrietta-cache.scm +++ b/henrietta-cache.scm @@ -9,16 +9,18 @@ usage: henrietta-cache [OPTION ...] -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 + -r -chicken-release REL the major CHICKEN release version for which to fetch (defaults to 4) Henrietta-cache will download cached copies of each egg listed in the file EGGLIST, to CACHEDIR. EOF -));| +) + (exit code));| (define *cache-directory* "cache") (define *egg-list* "egg-locations") -(define *chicken-release* (##sys#fudge 41)) +(define *chicken-release* 4) (define *init-file* #f) (define download-release-success-hook @@ -214,14 +216,13 @@ EOF (uri-template (cadr uri-info))) (for-each (lambda (egg-release) - (let ((cache-dir (make-pathname (list egg-cache-dir "tags") - egg-release))) + (let ((cache-dir (make-pathname egg-cache-dir egg-release))) (unless (file-exists? cache-dir) (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" + (printf "\tDownloading egg version ~A from ~A\n" egg-release uri) (flush-output) (handle-exceptions exn @@ -328,6 +329,11 @@ EOF (unless (pair? (cdr args)) (usage 1)) (set! *init-file* (cadr args)) (loop (cddr args))) + ((or (string=? arg "-r") (string=? arg "-chicken-release")) + (unless (pair? (cdr args)) (usage 1)) + (handle-exceptions exn (usage 1) + (set! *chicken-release* (string->number (cadr args)))) + (loop (cddr args))) ((and (positive? (string-length arg)) (char=? #\- (string-ref arg 0))) (if (> (string-length arg) 2) -- cgit v1.2.3