Peter Bex avatar Peter Bex committed b032ccb Merge

Merged in DerGuteMoritz/henrietta-cache (pull request #3)

Comments (0)

Files changed (1)

henrietta-cache.scm

-(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
   -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.
 (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)
                                         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))))))
 
 (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)))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.