suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Handle other branches

Browse Source
This commit is contained in:
Jay McCarthy 2011-11-15 07:22:55 -07:00
parent 1b69b79f6e
commit c0f8fef313
1 changed files with 30 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
collects/meta/drdr/scm.rkt
View File

@ -34,16 +34,22 @@
(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
[(list (regexp #rx"^([^ ]+) +([0-9abcdef]+)$" (list _ who end-commit)) ls
(regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ bstart bend branch)) [(list (regexp #rx"^([^ ]+) +([0-9abcdef]+)$" (list _ who end-commit))
...) (regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ bstart bend branch)))
(make-push-data who end-commit (make-push-data who bend
(make-immutable-hash (make-immutable-hash
(map (lambda (b bs be) (cons b (vector bs be))) (list (cons branch (vector bstart bend)))))]
branch bstart bend)))] [(list (regexp #rx"^([^ ]+) +([0-9abcdef]+)$" (list _ who end-commit))
[_ (regexp #rx"^([0-9abcdef]+) +([0-9abcdef]+) +(.+)$" (list _ bstart bend branch))
#f])) ...)
(make-push-data who end-commit
(make-immutable-hash
(map (lambda (b bs be) (cons b (vector bs be)))
branch bstart bend)))]
[_
#f]))
(define (pipe/proc cmds) (define (pipe/proc cmds)
(if (null? (cdr cmds)) (if (null? (cdr cmds))
@ -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")