summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--henrietta-cache.egg8
-rw-r--r--henrietta-cache.release-info.chicken-52
-rw-r--r--henrietta-cache.scm32
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))