diff options
| -rw-r--r-- | henrietta-cache.egg | 8 | ||||
| -rw-r--r-- | henrietta-cache.release-info.chicken-5 | 2 | ||||
| -rw-r--r-- | henrietta-cache.scm | 32 |
3 files changed, 26 insertions, 16 deletions
diff --git a/henrietta-cache.egg b/henrietta-cache.egg new file mode 100644 index 0000000..cab82c4 --- /dev/null +++ b/henrietta-cache.egg @@ -0,0 +1,8 @@ +;;;; henrietta-cache.egg -*- Scheme -*- + +((synopsis "Fetch and cache extensions from various sources for Henrietta to consume") + (category egg-tools) + (author "Peter Bex") + (dependencies http-client matchable srfi-1) + (license "BSD") + (components (program henrietta-cache))) diff --git a/henrietta-cache.release-info.chicken-5 b/henrietta-cache.release-info.chicken-5 new file mode 100644 index 0000000..be8fd59 --- /dev/null +++ b/henrietta-cache.release-info.chicken-5 @@ -0,0 +1,2 @@ +(repo git "http://code.more-magic.net/{egg-name}") +(uri targz "http://code.more-magic.net/{egg-name}/snapshot/{egg-name}-{egg-release}.tar.gz") diff --git a/henrietta-cache.scm b/henrietta-cache.scm index 0c7f266..c004924 100644 --- a/henrietta-cache.scm +++ b/henrietta-cache.scm @@ -1,8 +1,17 @@ (module henrietta-cache () -(import chicken scheme) +(import scheme) -(use utils files extras posix data-structures http-client matchable uri-common srfi-1) +(cond-expand + (chicken-4 (import chicken) + (use utils files extras posix data-structures ports + http-client matchable uri-common srfi-1) + (define read-list read-file)) + (chicken-5 (import (chicken base) (chicken condition) (chicken file) + (chicken format) (chicken string) (chicken port) + (chicken process) (chicken process-context) + (chicken pathname) (chicken io) + http-client matchable uri-common srfi-1))) (define (usage code) (print #<#EOF @@ -60,15 +69,6 @@ EOF (uri-encode-string (->string (cdr pattern))))) patterns))) -;; We could also use sendfile egg here, but do we want the dependency? -(define (copy-port in out #!optional limit) - (let ((bufsize 1024)) - (let loop ((data (read-string (min (or limit bufsize) bufsize) in))) - (unless (zero? (string-length data)) - (display data out) - (when limit (set! limit (- limit (string-length data)))) - (loop (read-string (min (or limit bufsize) bufsize) in)))))) - (define (call-with-output-pipe* cmd proc) (let ([p (open-output-pipe cmd)]) (proc p) @@ -181,7 +181,7 @@ EOF ;; CHICKEN 5 egg description format: .egg ((egg-file) (condition-case - (let* ((meta (car (call-with-input-request uri #f read-file))) + (let* ((meta (car (call-with-input-request uri #f read-list))) (files (alist-ref 'distribution-files meta))) (unless files (error "No \"distribution-files\" entry found in egg file" uri)) @@ -192,7 +192,7 @@ EOF ;; CHICKEN 4 egg meta information format: .meta ((meta-file) (condition-case - (let* ((meta (car (call-with-input-request uri #f read-file))) + (let* ((meta (car (call-with-input-request uri #f read-list))) (files (alist-ref 'files meta))) (unless files (error "No \"files\" entry found in meta file" uri)) @@ -274,7 +274,7 @@ EOF *chicken-release* egg-name uri message) (flush-output (current-error-port)) '()) - (with-input-from-request uri #f read-file))) + (with-input-from-request uri #f read-list))) (define (update-egg-cache) (when *init-file* @@ -323,8 +323,8 @@ EOF (else (collect-releases (cdr info) uris/releases uris)))))))) (let ((uri (uri-reference *egg-list*))) (if (absolute-uri? uri) ; Assume this is a http reference then - (call-with-input-request uri #f read-file) - (call-with-input-file *egg-list* read-file))))) + (call-with-input-request uri #f read-list) + (call-with-input-file *egg-list* read-list))))) (define *short-options* '(#\h #\c #\e)) |