summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormoritz <moritz@twoticketsplease.de>2012-01-26 22:53:47 +0100
committermoritz <moritz@twoticketsplease.de>2012-01-26 22:53:47 +0100
commit3ff72a728b850698eec5b204b74896ce14cca096 (patch)
tree42e9bea4fa9d9d4ef10646f208e1a95bc1a2539f
parentabfa3c32cec4409901050109ec2f94564794dc99 (diff)
downloadhenrietta-cache-3ff72a728b850698eec5b204b74896ce14cca096.tar.gz
add -i/--init-file option for giving an init file that is loaded
before the update process starts. implement hook functionality which can be used from the init file (download-release-success and download-release-error hooks only so far).
-rw-r--r--henrietta-cache.scm36
1 files changed, 34 insertions, 2 deletions
diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index 76276cb..24a00d5 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -18,6 +18,29 @@ EOF
(define *cache-directory* "cache")
(define *egg-list* "egg-locations")
(define *chicken-release* (##sys#fudge 41))
+(define *init-file* #f)
+
+(define download-release-success-hook
+ (make-parameter #f))
+
+(define download-release-error-hook
+ (make-parameter #f))
+
+(define hooks
+ `((download-release-success . ,download-release-success-hook)
+ (download-release-error . ,download-release-error-hook)))
+
+(define (run-hook hook-name . args)
+ (and-let* ((hook (or (alist-ref hook-name hooks)
+ (error "invalid hook" hook-name)))
+ (hook (and hook (hook))))
+ (condition-case
+ (apply hook args)
+ (exn ()
+ (print-error-message exn
+ (current-error-port)
+ (sprintf "Error running hook `~A'" hook-name))
+ (flush-output (current-error-port))))))
;; This works on raw URI strings, not URI objects (for now?)
(define (replace-uri-patterns uri patterns)
@@ -175,9 +198,11 @@ EOF
"Error downloading or extracting egg '~A' release ~A: "
egg-name egg-release)
(print-error-message exn (current-error-port))
- (flush-output (current-error-port)))
+ (flush-output (current-error-port))
+ (run-hook 'download-release-error egg-name egg-release))
(create-directory cache-dir #t)
- (download-release type uri cache-dir))))))
+ (download-release type uri cache-dir)
+ (run-hook 'download-release-success egg-name egg-release))))))
(cdr uri/releases))))
uris/releases)))
@@ -195,6 +220,9 @@ EOF
(with-input-from-request uri #f read-file)))
(define (update-egg-cache)
+ (when *init-file*
+ (load *init-file*))
+
(for-each
(lambda (egg)
(let* ((egg-name (car egg))
@@ -256,6 +284,10 @@ EOF
(unless (pair? (cdr args)) (usage 1))
(set! *egg-list* (cadr args))
(loop (cddr args)))
+ ((or (string=? arg "-i") (string=? arg "-init-file"))
+ (unless (pair? (cdr args)) (usage 1))
+ (set! *init-file* (cadr args))
+ (loop (cddr args)))
((and (positive? (string-length arg))
(char=? #\- (string-ref arg 0)))
(if (> (string-length arg) 2)