diff options
| author | Peter Bex <peter@more-magic.net> | 2011-05-28 23:05:59 +0200 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2011-05-28 23:05:59 +0200 |
| commit | f7bb3ebdff9f02f12cfb391d1de76230fcf5c652 (patch) | |
| tree | cd67f4ce45c3bafbbb7c1ad4e576b453ed1e2320 /pseudo-meta-egg-info.scm | |
| parent | a2cf934dd009c4e005ef3c560d6c3959e35e1174 (diff) | |
| download | pseudo-meta-egg-info-f7bb3ebdff9f02f12cfb391d1de76230fcf5c652.tar.gz | |
Make svn listings work properly, recursively
Diffstat (limited to 'pseudo-meta-egg-info.scm')
| -rw-r--r-- | pseudo-meta-egg-info.scm | 28 |
1 files changed, 18 insertions, 10 deletions
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" |