diff --git a/extra/webapps/mason/authors.txt b/extra/webapps/mason/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/mason/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor new file mode 100644 index 0000000000..63b042077e --- /dev/null +++ b/extra/webapps/mason/mason.factor @@ -0,0 +1,74 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators db db.tuples furnace.actions +http.server.responses kernel mason.platform mason.notify.server +math.order sequences sorting splitting xml.syntax xml.writer ; +IN: webapps.mason + +: git-link ( id -- link ) + [ "http://github.com/slavapestov/factor/commit/" prepend ] keep + [XML ><-> XML] ; + +: building ( builder string -- xml ) + swap current-git-id>> git-link + [XML <-> for <-> XML] ; + +: current-status ( builder -- xml ) + dup status>> { + { "dirty" [ drop "Dirty" ] } + { "clean" [ drop "Clean" ] } + { "starting" [ "Starting" building ] } + { "make-vm" [ "Compiling VM" building ] } + { "boot" [ "Bootstrapping" building ] } + { "test" [ "Testing" building ] } + [ 2drop "Unknown" ] + } case ; + +: binaries-link ( builder -- link ) + [ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend + dup [XML ><-> XML] ; + +: clean-image-link ( builder -- link ) + [ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend + dup [XML ><-> XML] ; + +: machine-table ( builder -- xml ) + { + [ os>> ] + [ cpu>> ] + [ host-name>> "." split1 drop ] + [ current-status ] + [ last-git-id>> dup [ git-link ] when ] + [ clean-git-id>> dup [ git-link ] when ] + [ binaries-link ] + [ clean-image-link ] + } cleave + [XML +

<-> / <->

+ + + + + + + +
Host name:<->
Current status:<->
Last build:<->
Last clean build:<->
Binaries:<->
Clean images:<->
+ XML] ; + +: machine-report ( builders -- xml ) + [ machine-table ] map + [XML +

Build farm status

+ <-> + XML] ; + +: ( -- action ) + + [ + mason-db [ + builder new select-tuples + [ [ [ os>> ] [ cpu>> ] bi 2array ] compare ] sort + machine-report xml>string + ] with-db + "text/html" + ] >>display ; \ No newline at end of file