aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README13
-rw-r--r--pseudo-meta-egg-info.scm38
2 files changed, 37 insertions, 14 deletions
diff --git a/README b/README
index cc14d53..8343e92 100644
--- a/README
+++ b/README
@@ -24,8 +24,9 @@ You can use it like this:
(use spiffy spiffy-uri-match pseudo-meta-egg-info)
;; Trailing slash is mandatory here!
-;; By default this uses the Chicken repo
-(egg-repo "http://example.com/your-egg-repo/eggs/release/4/")
+;; The {chicken-release} placeholder gets replaced by the major CHICKEN version.
+;; By default this uses the Chicken repo.
+(egg-repo "http://example.com/your-egg-repo/eggs/release/{chicken-release}/")
(vhost-map `((".*"
. ,(uri-match/spiffy
@@ -34,8 +35,8 @@ You can use it like this:
(start-server)
-This makes the release-info for egg MY-EGG available under
-http://localhost:8080/release-info?egg=MY-EGG
+This makes the release-info for the CHICKEN 4 version of egg MY-EGG, available under
+http://localhost:8080/release-info?egg=MY-EGG;release=4
-and the files-list for release 1.0 under
-http://localhost:8080/files-list?egg=MY-EGG;release=1.0
+and the files-list for release 1.0 for the CHICKEN 5 version of MY-EGG under
+http://localhost:8080/files-list?egg=MY-EGG;release=1.0;release=5
diff --git a/pseudo-meta-egg-info.scm b/pseudo-meta-egg-info.scm
index d1ff8d8..3dd406a 100644
--- a/pseudo-meta-egg-info.scm
+++ b/pseudo-meta-egg-info.scm
@@ -10,23 +10,39 @@
(import chicken scheme)
(use extras data-structures spiffy intarweb uri-common svn-client)
+(define *default-chicken-release* "4")
+
(define egg-repo
- (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/4/"))
+ (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/{chicken-release}/"))
+
+;; This works on raw URI strings, not URI objects (for now?)
+(define (replace-uri-patterns uri patterns)
+ (string-translate* uri (map (lambda (pattern)
+ (cons (conc "{" (car pattern) "}")
+ (uri-encode-string (->string (cdr pattern)))))
+ patterns)))
(define (release-info continue)
(or (and-let* ((params (uri-query (request-uri (current-request))))
(port (response-port (current-response)))
+ (chicken-release (string->number
+ (alist-ref 'release params eq?
+ *default-chicken-release*)))
(egg-name (alist-ref 'egg params))
((not (string=? egg-name "")))
(tag-dir (update-uri (uri-reference "")
path: (list egg-name "tags")))
- (repo-uri (uri-reference (egg-repo)))
+ (uri-string (replace-uri-patterns
+ (egg-repo)
+ `((chicken-release . ,chicken-release))))
+ (repo-uri (uri-reference uri-string))
(tags-uri (update-uri (uri-relative-to tag-dir repo-uri)
username: #f password: #f)))
- (or (and-let* ((releases (svn-client-list (uri->string tags-uri (constantly ""))
- svn-opt-revision-head 2
- (uri-username repo-uri)
- (uri-password repo-uri)))
+ (or (and-let* ((egg-releases
+ (svn-client-list (uri->string tags-uri (constantly ""))
+ svn-opt-revision-head 2
+ (uri-username repo-uri)
+ (uri-password repo-uri)))
(files-list-uri (conc (uri->string
(uri-relative-to
(uri-reference "files-list")
@@ -43,7 +59,7 @@
(not (string=? (svn-file-path r) "")))
(write `(release ,(svn-file-path r)) port)
(newline port)))
- releases)
+ egg-releases)
(close-output-port port))))
(send-status 404 (sprintf "Egg \"~A\" doesn't exist or has no tags dir" egg-name))))
(send-status 400 "No egg name given")))
@@ -51,13 +67,19 @@
(define (files-list continue)
(or (and-let* ((params (uri-query (request-uri (current-request))))
(port (response-port (current-response)))
+ (chicken-release (string->number
+ (alist-ref 'release params eq?
+ *default-chicken-release*)))
(egg-name (alist-ref 'egg params))
((not (string=? egg-name "")))
(egg-release (alist-ref 'release params))
((not (string=? egg-release "")))
(files-dir (update-uri (uri-reference "")
path: (list egg-name "tags" egg-release)))
- (repo-uri (uri-reference (egg-repo)))
+ (uri-string (replace-uri-patterns
+ (egg-repo)
+ `((chicken-release . ,chicken-release))))
+ (repo-uri (uri-reference uri-string))
(files-uri (update-uri (uri-relative-to files-dir repo-uri))))
(or (and-let* ((files (svn-client-list (uri->string files-uri (constantly ""))
svn-opt-revision-head #t