Source

pseudo-meta-egg-info / pseudo-meta-egg-info.scm

;;
;; pseudo-meta-egg-info - a Spiffy module for dynamically serving up
;; autogenerated release-info and file-lists for eggs in Subversion repos.
;;
;; This code was written by Peter Bex and is hereby placed in the Public Domain
;;
(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-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")
                                               (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)
                              (when (and (eq? (svn-file-kind r) 'directory)
                                         (not (string=? (svn-file-path r) "")))
                                (write `(release ,(svn-file-path r)) port)
                                (newline port)))
                            releases)
                  (close-output-port port))))
            (send-status 500 (sprintf "Egg \"~A\" doesn't exist or has no tags dir" 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))))
        (or (and-let* ((files (svn-client-list (uri->string files-uri (constantly ""))
                                               svn-opt-revision-head #t
                                               (uri-username repo-uri)
                                               (uri-password repo-uri))))
              (with-headers '((content-type "text/plain"))
                (lambda ()
                  (write-logged-response)
                  (display (uri->string files-uri
                                        (lambda (u p) (conc u ":" p))) port)
                  (newline port)
                  (for-each (lambda (f)
                              (when (eq? (svn-file-kind f) 'file)
                                (display (svn-file-path 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")))
)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.