From 09cbaef2bb8ad31c9b381c61825623aae71ffc03 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Thu, 26 May 2011 22:13:39 +0200
Subject: Add initial (crappy and broken) version of pseudo-meta-egg-info egg
---
pseudo-meta-egg-info.meta | 10 +++++++
pseudo-meta-egg-info.release-info | 2 ++
pseudo-meta-egg-info.scm | 63 +++++++++++++++++++++++++++++++++++++++
pseudo-meta-egg-info.setup | 3 ++
4 files changed, 78 insertions(+)
create mode 100644 pseudo-meta-egg-info.meta
create mode 100644 pseudo-meta-egg-info.release-info
create mode 100644 pseudo-meta-egg-info.scm
create mode 100644 pseudo-meta-egg-info.setup
diff --git a/pseudo-meta-egg-info.meta b/pseudo-meta-egg-info.meta
new file mode 100644
index 0000000..8056a48
--- /dev/null
+++ b/pseudo-meta-egg-info.meta
@@ -0,0 +1,10 @@
+;;;; pseudo-meta-egg-info.meta -*- Scheme -*-
+
+((synopsis "Provide automatically generated release-info and a pseudo-\"meta\"-file for eggs in svn")
+ (category egg-tools)
+ (doc-from-wiki)
+ (author "Peter Bex")
+ (depends spiffy uri-common svn-client)
+ (license "BSD")
+ (files "pseudo-meta-egg-info.meta" "pseudo-meta-egg-info.release-info"
+ "pseudo-meta-egg-info.scm" "pseudo-meta-egg-info.setup"))
diff --git a/pseudo-meta-egg-info.release-info b/pseudo-meta-egg-info.release-info
new file mode 100644
index 0000000..2a84311
--- /dev/null
+++ b/pseudo-meta-egg-info.release-info
@@ -0,0 +1,2 @@
+(repo hg "https://bitbucket.org/sjamaan/{egg-name}")
+(uri targz "https://bitbucket.org/sjamaan/{egg-name}/get/{egg-release}.tar.gz")
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
diff --git a/pseudo-meta-egg-info.setup b/pseudo-meta-egg-info.setup
new file mode 100644
index 0000000..d5282fa
--- /dev/null
+++ b/pseudo-meta-egg-info.setup
@@ -0,0 +1,3 @@
+;;;; pseudo-meta-egg-info.setup -*- Scheme -*-
+
+(standard-extension "pseudo-meta-egg-info" 0.1)
--
cgit v1.2.3