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

Adding tgz

Browse Source
This commit is contained in:
Jay McCarthy 2011-08-26 14:24:13 -06:00
parent e88c8dbaa0
commit 33f562c5fd
6 changed files with 80 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/meta/drdr/analyze.rkt
View File

@ -234,7 +234,8 @@
(define (trunk-path pth) (define (trunk-path pth)
(define rev (current-rev)) (define rev (current-rev))
((rebase-path (revision-log-dir rev) (revision-trunk-dir rev)) pth)) ((rebase-path (revision-log-dir rev) (revision-trunk-dir rev))
pth))
(define (analyze-path pth dir?) (define (analyze-path pth dir?)
(define rev (current-rev)) (define rev (current-rev))

2
collects/meta/drdr/copy.sh
View File

@ -1,3 +1,3 @@
#!/bin/sh #!/bin/sh
rsync -avz . ${1}drdr:/opt/svn/drdr/ --exclude=compiled --delete --exclude=data rsync -avz . ${1}drdr:/opt/svn/drdr/ --exclude=compiled --delete --exclude=data --exclude=builds

6
collects/meta/drdr/dirstruct.rkt
View File

@ -24,6 +24,8 @@
(define make-path (define make-path
(make-parameter "/usr/bin/make")) (make-parameter "/usr/bin/make"))
(define tar-path
(make-parameter "/bin/tar"))
(define Xvfb-path (define Xvfb-path
(make-parameter "/usr/bin/Xvfb")) (make-parameter "/usr/bin/Xvfb"))
@ -60,6 +62,8 @@
(define (revision-trunk-dir rev) (define (revision-trunk-dir rev)
(build-path (revision-dir rev) "trunk")) (build-path (revision-dir rev) "trunk"))
(define (revision-trunk.tgz rev)
(build-path (revision-dir rev) "trunk.tgz"))
(define (revision-commit-msg rev) (define (revision-commit-msg rev)
(build-path (revision-dir rev) "commit-msg")) (build-path (revision-dir rev) "commit-msg"))
@ -101,6 +105,7 @@
[plt-data-directory (-> path?)] [plt-data-directory (-> path?)]
[plt-future-build-directory (-> path?)] [plt-future-build-directory (-> path?)]
[drdr-directory (parameter/c path-string?)] [drdr-directory (parameter/c path-string?)]
[tar-path (parameter/c (or/c false/c string?))]
[make-path (parameter/c (or/c false/c string?))] [make-path (parameter/c (or/c false/c string?))]
[Xvfb-path (parameter/c (or/c false/c string?))] [Xvfb-path (parameter/c (or/c false/c string?))]
[vncviewer-path (parameter/c (or/c false/c string?))] [vncviewer-path (parameter/c (or/c false/c string?))]
@ -120,5 +125,6 @@
[revision-log-dir (exact-nonnegative-integer? . -> . path?)] [revision-log-dir (exact-nonnegative-integer? . -> . path?)]
[revision-analyze-dir (exact-nonnegative-integer? . -> . path-string?)] [revision-analyze-dir (exact-nonnegative-integer? . -> . path-string?)]
[revision-trunk-dir (exact-nonnegative-integer? . -> . path?)] [revision-trunk-dir (exact-nonnegative-integer? . -> . path?)]
[revision-trunk.tgz (exact-nonnegative-integer? . -> . path?)]
[revision-archive (exact-nonnegative-integer? . -> . path?)] [revision-archive (exact-nonnegative-integer? . -> . path?)]
[path->revision (path-string? . -> . exact-nonnegative-integer?)]) [path->revision (path-string? . -> . exact-nonnegative-integer?)])

3
collects/meta/drdr/make-archive.rkt
View File

@ -23,7 +23,8 @@
(create-archive tmp-path (revision-dir rev)) (create-archive tmp-path (revision-dir rev))
(rename-file-or-directory tmp-path archive-path) (rename-file-or-directory tmp-path archive-path)
(archive-directory (revision-log-dir rev)) (archive-directory (revision-log-dir rev))
(archive-directory (revision-analyze-dir rev))))) (archive-directory (revision-analyze-dir rev))
(safely-delete-directory (revision-trunk.tgz rev)))))
(define mode (make-parameter 'single)) (define mode (make-parameter 'single))

10
collects/meta/drdr/plt-build.rkt
View File

@ -67,7 +67,15 @@
#:env (current-env) #:env (current-env)
(build-path log-dir "src" "build" "make-install") (build-path log-dir "src" "build" "make-install")
(make-path) (make-path)
(list "-j" (number->string (number-of-cpus)) "install"))))) (list "-j" (number->string (number-of-cpus)) "install"))))
(run/collect/wait/log
#:timeout (current-make-install-timeout-seconds)
#:env (current-env)
(build-path log-dir "src" "build" "archive")
(tar-path)
(list "-czvf"
(path->string (revision-trunk.tgz rev))
(path->string trunk-dir))))
(define (call-with-temporary-directory thunk) (define (call-with-temporary-directory thunk)
(define tempdir (symbol->string (gensym 'tmpdir))) (define tempdir (symbol->string (gensym 'tmpdir)))

100
collects/meta/drdr/render.rkt
View File

@ -137,6 +137,15 @@
(tr ([class "author"]) (td "Author:") (td ,author)) (tr ([class "author"]) (td "Author:") (td ,author))
(tr ([class "date"]) (td "Build Start:") (td ,bdate/s)) (tr ([class "date"]) (td "Build Start:") (td ,bdate/s))
(tr ([class "date"]) (td "Build End:") (td ,bdate/e)) (tr ([class "date"]) (td "Build End:") (td ,bdate/e))
,@(if (file-exists? (revision-trunk.tgz (current-rev)))
`((tr ([class "date"])
(td "Archive")
(td (a
([href
,(format "/builds/~a/trunk.tgz"
(current-rev))])
"trunk.tgz"))))
`())
(tr ([class "hash"]) (tr ([class "hash"])
(td "Diff:") (td "Diff:")
(td (a ([href ,(log->url gp)]) (td (a ([href ,(log->url gp)])
@ -200,46 +209,57 @@
(define url (format "http://svn.racket-lang.org/view?view=rev&revision=~a" num)) (define url (format "http://svn.racket-lang.org/view?view=rev&revision=~a" num))
(define cg-id (symbol->string (gensym 'changes))) (define cg-id (symbol->string (gensym 'changes)))
(define ccss-id (symbol->string (gensym 'changes))) (define ccss-id (symbol->string (gensym 'changes)))
`(table ([class "data"]) `(table
(tr ([class "author"]) (td "Author:") (td ,author)) ([class "data"])
(tr ([class "date"]) (tr ([class "author"]) (td "Author:") (td ,author))
(td "Build Start:") (tr ([class "date"])
(td ,bdate/s)) (td "Build Start:")
(tr ([class "date"]) (td "Build End:") (td ,bdate/e)) (td ,bdate/s))
(tr ([class "rev"]) (tr ([class "date"]) (td "Build End:") (td ,bdate/e))
(td "Commit:") (tr ([class "rev"])
(td (a ([href ,url]) ,(number->string num)))) (td "Commit:")
(tr ([class "date"]) (td (a ([href ,url]) ,(number->string num))))
(td "Date:") (tr ([class "date"])
(td ,(svn-date->nice-date date))) (td "Date:")
(tr ([class "msg"]) (td "Log:") (td (pre ,msg))) (td ,(svn-date->nice-date date)))
(tr ([class "changes"]) (tr ([class "msg"]) (td "Log:") (td (pre ,msg)))
(td (tr ([class "changes"])
(a ([href ,(format "javascript:TocviewToggle(\"~a\",\"~a\");" cg-id ccss-id)]) (td
(span ([id ,cg-id]) 9658) "Changes:")) (a ([href
(td ,(format
(div ([id ,ccss-id] "javascript:TocviewToggle(\"~a\",\"~a\");"
[style "display: none;"]) cg-id ccss-id)])
,@(map (match-lambda (span ([id ,cg-id]) 9658) "Changes:"))
[(struct svn-change (action path)) (td
`(p ([class "output"]) (div
,(symbol->string action) " " ([id ,ccss-id]
,(if (regexp-match #rx"^/trunk/collects" path) [style "display: none;"])
(local [(define path-w/o-trunk ,@(map
(apply build-path (list-tail (explode-path path) 2))) (match-lambda
(define html-path [(struct svn-change (action path))
(if (looks-like-directory? path) `(p ([class "output"])
(format "~a/" path-w/o-trunk) ,(symbol->string action) " "
path-w/o-trunk)) ,(if (regexp-match
(define path-url #rx"^/trunk/collects"
(path->string* html-path)) path)
(define path-tested? (local
#t)] [(define path-w/o-trunk
(if path-tested? (apply build-path
`(a ([href ,path-url]) ,path) (list-tail
path)) (explode-path path) 2)))
path))]) (define html-path
changes)))))] (if (looks-like-directory? path)
(format "~a/" path-w/o-trunk)
path-w/o-trunk))
(define path-url
(path->string* html-path))
(define path-tested?
#t)]
(if path-tested?
`(a ([href ,path-url]) ,path)
path))
path))])
changes)))))]
[else [else
'" "])) '" "]))