aboutsummaryrefslogtreecommitdiff
path: root/pseudo-meta-egg-info.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2011-05-26 22:13:39 +0200
committerPeter Bex <peter@more-magic.net>2011-05-26 22:13:39 +0200
commit09cbaef2bb8ad31c9b381c61825623aae71ffc03 (patch)
tree1f491277860c73bdb59b38f232affd0354fdde4f /pseudo-meta-egg-info.scm
downloadpseudo-meta-egg-info-09cbaef2bb8ad31c9b381c61825623aae71ffc03.tar.gz
Add initial (crappy and broken) version of pseudo-meta-egg-info egg
Diffstat (limited to 'pseudo-meta-egg-info.scm')
-rw-r--r--pseudo-meta-egg-info.scm63
1 files changed, 63 insertions, 0 deletions
diff --git a/pseudo-meta-egg-info.scm b/pseudo-meta-egg-info.scm
new file mode 100644
index 0000000..f104e47
--- /dev/null
+++ b/pseudo-meta-egg-info.scm
@@ -0,0 +1,63 @@
+(module pseudo-meta-egg-info
+ (egg-repo release-info files-list)
+
+(import chicken scheme)
+(use extras data-structures spiffy intarweb uri-common svn-client)
+
+(define egg-repo
+ (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/4/"))
+
+(define (release-info continue)
+ (or (and-let* ((params (uri-query (request-uri (current-request))))
+ (port (response-port (current-response)))
+ (egg-name (alist-ref 'egg params))
+ (tag-dir (update-uri (uri-reference "")
+ path: (list egg-name "tags")))
+ (repo-uri (uri-reference (egg-repo)))
+ (tags-uri (update-uri (uri-relative-to tag-dir repo-uri)
+ username: #f password: #f)))
+ (or (and-let* ((releases (svn-ls (uri->string tags-uri (constantly "")) '()
+ (uri-username repo-uri)
+ (uri-password repo-uri)))
+ (files-list-uri (conc (uri->string
+ (uri-relative-to
+ (uri-reference "files-list")
+ (request-uri (current-request))))
+ ;; template, so don't make this a query
+ "?egg={egg-name};release={egg-release}")))
+ (with-headers '((content-type "text/plain"))
+ (lambda ()
+ (write-logged-response)
+ (write `(uri files-list ,files-list-uri) port)
+ (newline port)
+ (for-each (lambda (r)
+ (write `(release ,(car r)) port)
+ (newline port))
+ releases)
+ (close-output-port port))))
+ (send-status 500 (sprintf "Egg \"~A\" doesn't exist" egg-name))))
+ (send-status 500 "No egg name given")))
+
+(define (files-list continue)
+ (or (and-let* ((params (uri-query (request-uri (current-request))))
+ (port (response-port (current-response)))
+ (egg-name (alist-ref 'egg params))
+ (egg-release (alist-ref 'release params))
+ (files-dir (update-uri (uri-reference "")
+ path: (list egg-name "tags" egg-release)))
+ (repo-uri (uri-reference (egg-repo)))
+ (files-uri (update-uri (uri-relative-to files-dir repo-uri)
+ username: #f password: #f)))
+ (or (and-let* ((files (svn-ls (uri->string files-uri) '() ;; Needs recursion!
+ (uri-username repo-uri)
+ (uri-password repo-uri))))
+ (with-headers '((content-type "text/plain"))
+ (lambda ()
+ (write-logged-response)
+ (for-each (lambda (f) (display (car f) port) (newline port)) files)
+ (close-output-port port))))
+ (send-status 500
+ (sprintf "Release \"~A\" for egg \"~A\" doesn't exist"
+ egg-release egg-name))))
+ (send-status 500 "No egg name or release given")))
+) \ No newline at end of file