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