From 89dfdf725593cd2e1a1352e4b7b9370a5a31cdd4 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Wed, 5 Sep 2018 18:23:11 +0200
Subject: Port to CHICKEN 5

This drops support for CHICKEN versions before 4.6 (copy-port is required now)
---
 henrietta-cache.egg                    |  8 ++++++++
 henrietta-cache.release-info.chicken-5 |  2 ++
 henrietta-cache.scm                    | 32 ++++++++++++++++----------------
 3 files changed, 26 insertions(+), 16 deletions(-)
 create mode 100644 henrietta-cache.egg
 create mode 100644 henrietta-cache.release-info.chicken-5

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))
 
-- 
cgit v1.2.3