Handle other branches

This commit is contained in:
Jay McCarthy 2011-11-15 07:22:55 -07:00
parent 1b69b79f6e
commit c0f8fef313

View File

@ -34,7 +34,13 @@
(get-pure-port (get-pure-port
(string->url (string->url
(format "~a/pushes/~a/~a" git-url-base push-n100s push-nrem))))) (format "~a/pushes/~a/~a" git-url-base push-n100s push-nrem)))))
(match ls (match
ls
[(list (regexp #rx"^([^ ]+) +([0-9abcdef]+)$" (list _ who end-commit))
(regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ bstart bend branch)))
(make-push-data who bend
(make-immutable-hash
(list (cons branch (vector bstart bend)))))]
[(list (regexp #rx"^([^ ]+) +([0-9abcdef]+)$" (list _ who end-commit)) [(list (regexp #rx"^([^ ]+) +([0-9abcdef]+)$" (list _ who end-commit))
(regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ bstart bend branch)) (regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ bstart bend branch))
...) ...)
@ -168,9 +174,15 @@
(git-path) (git-path)
"--no-pager" "log" "--format=format:%P" start "-1"))) "--no-pager" "log" "--format=format:%P" start "-1")))
(define (git-push-start-commit gp) (define (git-push-start-commit gp)
(git-commit-hash (last (git-push-commits gp)))) (define cs (git-push-commits gp))
(if (empty? cs)
"xxxxxxxxxxxxxxxxxxxxxxxxx"
(git-commit-hash (last cs))))
(define (git-push-end-commit gp) (define (git-push-end-commit gp)
(git-commit-hash (first (git-push-commits gp)))) (define cs (git-push-commits gp))
(if (empty? cs)
"xxxxxxxxxxxxxxxxxxxxxxxxx"
(git-commit-hash (first cs))))
(provide/contract (provide/contract
[git-push-previous-commit (git-push? . -> . string?)] [git-push-previous-commit (git-push? . -> . string?)]
[git-push-start-commit (git-push? . -> . string?)] [git-push-start-commit (git-push? . -> . string?)]
@ -198,19 +210,23 @@
(void)) (void))
(define (scm-export-repo rev repo dest) (define (scm-export-repo rev repo dest)
(define end (push-data-end-commit (push-info rev)))
(printf "Exporting ~v where end = ~a\n"
(list rev repo dest)
end)
(pipe (pipe
(system* (system*
(git-path) "archive" (git-path) "archive"
(format "--remote=~a" repo) (format "--remote=~a" repo)
(format "--prefix=~a/" (regexp-replace #rx"/+$" (path->string* dest) "")) (format "--prefix=~a/" (regexp-replace #rx"/+$" (path->string* dest) ""))
"--format=tar" "--format=tar"
(push-data-end-commit (push-info rev))) end)
(system* (find-executable-path "tar") "xf" "-" "--absolute-names")) (system* (find-executable-path "tar") "xf" "-" "--absolute-names"))
(void)) (void))
(define (scm-update repo) (define (scm-update repo)
(parameterize ([current-directory repo]) (parameterize ([current-directory repo])
(system* (git-path) "fetch" git-url-base)) (system* (git-path) "fetch"))
(void)) (void))
(define master-branch "refs/heads/master") (define master-branch "refs/heads/master")