builder.release: more refactoring

db4
Eduardo Cavazos 2008-04-12 04:12:07 -05:00
parent 51faf8e337
commit 61de920316
4 changed files with 32 additions and 124 deletions

View File

@ -16,3 +16,4 @@ SYMBOL: builds-dir
VAR: stamp
SYMBOL: upload-to-factorcode

View File

@ -1,5 +1,5 @@
USING: combinators system sequences io.launcher prettyprint
USING: kernel combinators system sequences io.files io.launcher prettyprint
builder.util
builder.common ;
@ -47,3 +47,12 @@ IN: builder.release.archive
: make-archive ( -- ) archive-cmd to-strings try-process ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: releases ( -- path )
builds "releases" append-path
dup exists? not
[ dup make-directory ]
when ;
: save-archive ( -- ) archive-name releases move-file-into ;

View File

@ -1,6 +1,8 @@
USING: system sequences prettyprint io.files io.launcher bootstrap.image
builder.util ;
USING: kernel system namespaces sequences prettyprint io.files io.launcher
bootstrap.image
builder.util
builder.common ;
IN: builder.release.branch
@ -24,7 +26,7 @@ IN: builder.release.branch
to-strings
try-process ;
: update-clean-branch ( -- )
: (update-clean-branch) ( -- )
"factor"
[
push-to-clean-branch
@ -32,3 +34,7 @@ IN: builder.release.branch
]
with-directory ;
: update-clean-branch ( -- )
upload-to-factorcode get
[ update-clean-branch ]
when ;

View File

@ -4,131 +4,23 @@ USING: kernel system namespaces sequences splitting combinators
bake combinators.cleave
builder.util
builder.common
builder.release.archive ;
builder.release.branch
builder.release.tidy
builder.release.archive
builder.release.upload ;
IN: builder.release
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: releases ( -- path )
builds "releases" append-path
dup exists? not
[ dup make-directory ]
when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: common-files ( -- seq )
{
"boot.x86.32.image"
"boot.x86.64.image"
"boot.macosx-ppc.image"
"boot.linux-ppc.image"
"vm"
"temp"
"logs"
".git"
".gitignore"
"Makefile"
"unmaintained"
"build-support"
} ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: remove-common-files ( -- )
{ "rm" "-rf" common-files } to-strings try-process ;
: remove-factor-app ( -- )
os macosx? not [ { "rm" "-rf" "Factor.app" } try-process ] when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SYMBOL: upload-to-factorcode
: remote-location ( -- dest )
"factorcode.org:/var/www/factorcode.org/newsite/downloads"
platform
append-path ;
: upload ( -- )
{ "scp" archive-name remote-location } to-strings
[ "Error uploading binary to factorcode" print ]
run-or-bail ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: maybe-upload ( -- )
upload-to-factorcode get
[ upload ]
when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! update-clean-branch
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: branch-name ( -- string )
{ "clean" [ os unparse ] cpu- } to-strings "-" join ;
: refspec ( -- string ) "master:" branch-name append ;
: push-to-clean-branch ( -- )
{ "git" "push" "factorcode.org:/git/factor.git" refspec }
to-strings
try-process ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: upload-clean-image ( -- )
{
"scp"
my-boot-image-name
"factorcode.org:/var/www/factorcode.org/newsite/images/clean"
}
to-strings
try-process ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: update-clean-branch ( -- )
"factor"
[
push-to-clean-branch
upload-clean-image
]
with-directory ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: maybe-update-clean-branch ( -- )
upload-to-factorcode get
[ update-clean-branch ]
when ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: release ( -- )
maybe-update-clean-branch
"factor"
[
remove-factor-app
remove-common-files
]
with-directory
: (release) ( -- )
update-clean-branch
tidy
make-archive
maybe-upload
archive-name releases move-file-into ;
upload
save-archive ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: clean-build? ( -- ? )
{ "load-everything-vocabs" "test-all-vocabs" } [ eval-file empty? ] all? ;
: release? ( -- ? )
{
"./load-everything-vocabs"
"./test-all-vocabs"
}
[ eval-file empty? ]
all? ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: maybe-release ( -- ) release? [ release ] when ;
: release ( -- ) clean-build? [ (release) ] when ;