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 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 rev (current-rev))

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

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

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

@ -67,7 +67,15 @@
#:env (current-env)
(build-path log-dir "src" "build" "make-install")
(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 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 "date"]) (td "Build Start:") (td ,bdate/s))
(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"])
(td "Diff:")
(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 cg-id (symbol->string (gensym 'changes)))
(define ccss-id (symbol->string (gensym 'changes)))
`(table ([class "data"])
(tr ([class "author"]) (td "Author:") (td ,author))
(tr ([class "date"])
(td "Build Start:")
(td ,bdate/s))
(tr ([class "date"]) (td "Build End:") (td ,bdate/e))
(tr ([class "rev"])
(td "Commit:")
(td (a ([href ,url]) ,(number->string num))))
(tr ([class "date"])
(td "Date:")
(td ,(svn-date->nice-date date)))
(tr ([class "msg"]) (td "Log:") (td (pre ,msg)))
(tr ([class "changes"])
(td
(a ([href ,(format "javascript:TocviewToggle(\"~a\",\"~a\");" cg-id ccss-id)])
(span ([id ,cg-id]) 9658) "Changes:"))
(td
(div ([id ,ccss-id]
[style "display: none;"])
,@(map (match-lambda
[(struct svn-change (action path))
`(p ([class "output"])
,(symbol->string action) " "
,(if (regexp-match #rx"^/trunk/collects" path)
(local [(define path-w/o-trunk
(apply build-path (list-tail (explode-path path) 2)))
(define html-path
(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)))))]
`(table
([class "data"])
(tr ([class "author"]) (td "Author:") (td ,author))
(tr ([class "date"])
(td "Build Start:")
(td ,bdate/s))
(tr ([class "date"]) (td "Build End:") (td ,bdate/e))
(tr ([class "rev"])
(td "Commit:")
(td (a ([href ,url]) ,(number->string num))))
(tr ([class "date"])
(td "Date:")
(td ,(svn-date->nice-date date)))
(tr ([class "msg"]) (td "Log:") (td (pre ,msg)))
(tr ([class "changes"])
(td
(a ([href
,(format
"javascript:TocviewToggle(\"~a\",\"~a\");"
cg-id ccss-id)])
(span ([id ,cg-id]) 9658) "Changes:"))
(td
(div
([id ,ccss-id]
[style "display: none;"])
,@(map
(match-lambda
[(struct svn-change (action path))
`(p ([class "output"])
,(symbol->string action) " "
,(if (regexp-match
#rx"^/trunk/collects"
path)
(local
[(define path-w/o-trunk
(apply build-path
(list-tail
(explode-path path) 2)))
(define html-path
(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
'" "]))