-! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
+! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel calendar io.directories io.encodings.utf8
io.files io.launcher io.pathnames namespaces prettyprint
-combinators mason.child mason.cleanup mason.common mason.config
+combinators sequences mason.child mason.cleanup mason.common mason.config
mason.docs mason.release mason.report mason.email mason.git
mason.notify mason.platform mason.updates ;
QUALIFIED: continuations
build-dir make-directory ;
: enter-build-dir ( -- )
+ "Building in directory " build-dir append print-timestamp
build-dir set-current-directory ;
: clone-source ( -- )
+ "Cloning GIT repository" print-timestamp
"git" "clone" builds-dir get "factor" append-path 3array
short-running-process ;
-! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
+! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces sequences splitting system accessors
math.functions make io io.files io.pathnames io.directories
continuations strings io.sockets ;
IN: mason.common
+: print-timestamp ( string -- )
+ now timestamp>string write bl print flush ;
+
ERROR: no-host-name ;
: short-host-name ( -- string )
_ >>subject
send-email
] [
- "E-MAILING FAILED:" print
+ "E-MAILING FAILED:" print-timestamp
error. flush
] recover ;
: git-clone ( -- )
#! Must be run from builds-dir
+ "Cloning initial repository" print-timestamp
git-clone-cmd try-output-process ;
: git-pull-cmd ( -- cmd )
http-post 2drop
] retry
] [
- "STATUS NOTIFY FAILED:" print
+ "STATUS NOTIFY FAILED:" print-timestamp
error. flush
] recover
] [ 3drop ] if ;
f f "idle" status-notify ;
: notify-begin-build ( git-id -- )
- [ "Starting build of GIT ID " write print flush ]
+ [ "Starting build of GIT ID " prepend print-timestamp ]
[ f swap "git-id" status-notify ]
bi ;
: notify-make-vm ( -- )
- "Compiling VM" print flush
+ "Compiling VM" print-timestamp
f f "make-vm" status-notify ;
: notify-boot ( -- )
- "Bootstrapping" print flush
+ "Bootstrapping" print-timestamp
f f "boot" status-notify ;
: notify-test ( -- )
- "Running tests" print flush
+ "Running tests" print-timestamp
f f "test" status-notify ;
: notify-report ( status -- )
- [ "Build finished with status: " write . flush ]
+ [ name>> "Build finished with status: " prepend print-timestamp ]
[
[ "report" utf8 file-contents ] dip
[ name>> "report" status-notify ] [ email-report ] 2bi
f f "finish" status-notify ;
: notify-release ( archive-name -- )
- [ "Uploaded " prepend [ print flush ] [ mason-tweet ] bi ]
+ [ "Uploaded " prepend [ print-timestamp ] [ mason-tweet ] bi ]
[ f swap "release" status-notify ]
bi ;