1 ! Copyright (C) 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors calendar combinators db.tuples furnace.actions
4 furnace.redirection html.forms http.server.responses io kernel
5 namespaces validators webapps.mason.utils webapps.mason.backend ;
6 IN: webapps.mason.status-update
8 : find-builder ( host-name os cpu -- builder )
13 dup select-tuple [ ] [ dup insert-tuple ] ?if ;
15 : heartbeat ( builder -- )
16 now >>heartbeat-timestamp
19 : status ( builder status -- )
21 now >>current-timestamp
24 : idle ( builder -- ) +idle+ status ;
26 : git-id ( builder id -- ) >>current-git-id +starting+ status ;
28 : make-vm ( builder -- ) +make-vm+ status ;
30 : boot ( builder -- ) +boot+ status ;
32 : test ( builder -- ) +test+ status ;
34 : report ( builder content status -- )
37 now >>current-timestamp
40 dup current-git-id>> >>clean-git-id
41 dup current-timestamp>> >>clean-timestamp
43 dup current-git-id>> >>last-git-id
44 dup current-timestamp>> >>last-timestamp
47 : upload ( builder -- ) +upload+ status ;
49 : finish ( builder -- ) +finish+ status ;
51 : release ( builder name -- )
53 dup clean-git-id>> >>release-git-id
56 : update-builder ( builder -- )
58 { "heartbeat" [ heartbeat ] }
60 { "git-id" [ "arg" value git-id ] }
61 { "make-vm" [ make-vm ] }
64 { "report" [ "report" value "arg" value report ] }
65 { "upload" [ upload ] }
66 { "finish" [ finish ] }
67 { "release" [ "arg" value release ] }
70 : <status-update-action> ( -- action )
74 { "host-name" [ v-one-line ] }
75 { "target-cpu" [ v-one-line ] }
76 { "target-os" [ v-one-line ] }
77 { "message" [ v-one-line ] }
78 { "arg" [ [ v-one-line ] v-optional ] }
91 [ update-builder ] [ update-tuple ] bi
93 "OK" "text/plain" <content>