diff options
| -rw-r--r-- | pseudo-meta-egg-info.meta | 2 | ||||
| -rw-r--r-- | pseudo-meta-egg-info.scm | 28 |
2 files changed, 19 insertions, 11 deletions
diff --git a/pseudo-meta-egg-info.meta b/pseudo-meta-egg-info.meta index f566bdb..e2ecab9 100644 --- a/pseudo-meta-egg-info.meta +++ b/pseudo-meta-egg-info.meta @@ -4,7 +4,7 @@ (category egg-tools) (doc-from-wiki) (author "Peter Bex") - (depends spiffy uri-common svn-client) + (depends spiffy uri-common (svn-client 0.17)) (license "Public Domain") (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.scm b/pseudo-meta-egg-info.scm index 1e02f38..097c22e 100644 --- a/pseudo-meta-egg-info.scm +++ b/pseudo-meta-egg-info.scm @@ -22,9 +22,10 @@ (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))) + (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") @@ -37,8 +38,10 @@ (write `(uri files-list ,files-list-uri) port) (newline port) (for-each (lambda (r) - (write `(release ,(car r)) port) - (newline port)) + (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" egg-name)))) @@ -50,19 +53,24 @@ (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 ""))) + 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-ls (uri->string files-uri (constantly "")) '() ;; Needs recursion! - (uri-username repo-uri) - (uri-password 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) (display (car f) port) (newline port)) files) + (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" |