1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors combinators combinators.smart command-line db
4 db.sqlite db.tuples db.types io io.encodings.utf8 io.files
5 present kernel namespaces sequences calendar ;
6 IN: mason.notify.server
8 CONSTANT: +starting+ "starting"
9 CONSTANT: +make-vm+ "make-vm"
10 CONSTANT: +boot+ "boot"
11 CONSTANT: +test+ "test"
12 CONSTANT: +clean+ "status-clean"
13 CONSTANT: +dirty+ "status-dirty"
14 CONSTANT: +error+ "status-error"
18 clean-git-id clean-timestamp
19 last-release release-git-id
20 last-git-id last-timestamp last-report
21 current-git-id current-timestamp
25 { "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
26 { "os" "OS" TEXT +user-assigned-id+ }
27 { "cpu" "CPU" TEXT +user-assigned-id+ }
29 { "clean-git-id" "CLEAN_GIT_ID" TEXT }
30 { "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP }
32 { "last-release" "LAST_RELEASE" TEXT }
33 { "release-git-id" "RELEASE_GIT_ID" TEXT }
35 { "last-git-id" "LAST_GIT_ID" TEXT }
36 { "last-timestamp" "LAST_TIMESTAMP" TIMESTAMP }
37 { "last-report" "LAST_REPORT" TEXT }
39 { "current-git-id" "CURRENT_GIT_ID" TEXT }
40 ! Can't name it CURRENT_TIMESTAMP because of bug in db library
41 { "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP }
42 { "status" "STATUS" TEXT }
45 SYMBOLS: host-name target-os target-cpu message message-arg ;
47 : parse-args ( command-line -- )
48 dup last message-arg set
58 : find-builder ( -- builder )
60 host-name get >>host-name
63 dup select-tuple [ ] [ dup insert-tuple ] ?if ;
65 : git-id ( builder id -- )
66 >>current-git-id +starting+ >>status drop ;
68 : make-vm ( builder -- ) +make-vm+ >>status drop ;
70 : boot ( builder -- ) +boot+ >>status drop ;
72 : test ( builder -- ) +test+ >>status drop ;
74 : report ( builder status content -- )
75 [ >>status ] [ >>last-report ] bi*
76 dup status>> +clean+ = [
77 dup current-git-id>> >>clean-git-id
78 dup current-timestamp>> >>clean-timestamp
80 dup current-git-id>> >>last-git-id
81 dup current-timestamp>> >>last-timestamp
84 : release ( builder name -- )
86 dup clean-git-id>> >>release-git-id
89 : update-builder ( builder -- )
91 { "git-id" [ message-arg get git-id ] }
92 { "make-vm" [ make-vm ] }
95 { "report" [ message-arg get contents report ] }
96 { "release" [ message-arg get release ] }
99 : mason-db ( -- db ) "resource:mason.db" <sqlite-db> ;
101 : handle-update ( command-line timestamp -- )
103 [ parse-args find-builder ] dip >>current-timestamp
104 [ update-builder ] [ update-tuple ] bi
107 CONSTANT: log-file "resource:mason.log"
109 : log-update ( command-line timestamp -- )
111 present write ": " write " " join print
112 ] with-file-appender ;
115 command-line get now [ log-update ] [ handle-update ] 2bi ;