extra/webapps/mason/backend/backend.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors calendar db db.sqlite db.tuples db.types kernel
   4 math math.order sequences combinators.short-circuit
   5 io.pathnames ;
   6 IN: webapps.mason.backend
   7
   8 CONSTANT: +idle+ "idle"
   9 CONSTANT: +starting+ "starting"
  10 CONSTANT: +make-vm+ "make-vm"
  11 CONSTANT: +boot+ "boot"
  12 CONSTANT: +test+ "test"
  13 CONSTANT: +upload+ "upload"
  14 CONSTANT: +finish+ "finish"
  15
  16 CONSTANT: +dirty+ "status-dirty"
  17 CONSTANT: +error+ "status-error"
  18 CONSTANT: +clean+ "status-clean"
  19
  20 TUPLE: builder
  21 host-name os cpu heartbeat-timestamp
  22 clean-git-id clean-timestamp
  23 last-release release-git-id
  24 last-git-id last-timestamp last-report
  25 current-git-id current-timestamp
  26 status ;
  27
  28 builder "BUILDERS" {
  29     { "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
  30     { "os" "OS" TEXT +user-assigned-id+ }
  31     { "cpu" "CPU" TEXT +user-assigned-id+ }
  32     { "heartbeat-timestamp" "HEARTBEAT_TIMESTAMP" TIMESTAMP }
  33
  34     { "clean-git-id" "CLEAN_GIT_ID" TEXT }
  35     { "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP }
  36
  37     { "last-release" "LAST_RELEASE" TEXT }
  38     { "release-git-id" "RELEASE_GIT_ID" TEXT }
  39
  40     { "last-git-id" "LAST_GIT_ID" TEXT }
  41     { "last-timestamp" "LAST_TIMESTAMP" TIMESTAMP }
  42     { "last-report" "LAST_REPORT" TEXT }
  43
  44     { "current-git-id" "CURRENT_GIT_ID" TEXT }
  45     ! Can't name it CURRENT_TIMESTAMP because of bug in db library
  46     { "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP }
  47     { "status" "STATUS" TEXT }
  48 } define-persistent
  49
  50 TUPLE: counter id value ;
  51
  52 counter "COUNTER" {
  53     { "id" "ID" INTEGER +db-assigned-id+ }
  54     { "value" "VALUE" INTEGER }
  55 } define-persistent
  56
  57 : counter-tuple ( -- counter )
  58     counter new select-tuple
  59     [ counter new dup insert-tuple ] unless* ;
  60
  61 : counter-value ( -- n )
  62     counter-tuple value>> 0 or ;
  63
  64 : increment-counter-value ( -- n )
  65     counter-tuple [ 0 or 1 + dup ] change-value update-tuple ;
  66
  67 : all-builders ( -- builders )
  68     builder new select-tuples ; inline
  69
  70 : offline? ( builder -- ? )
  71     heartbeat-timestamp>> 30 minutes ago before? ;
  72
  73 : broken? ( builder -- ? )
  74     [ clean-git-id>> ] [ last-git-id>> ] bi = not ;
  75
  76 : funny-builders ( -- offline broken )
  77     all-builders
  78     [ [ offline? ] filter ]
  79     [ [ broken? ] filter ]
  80     bi ;
  81
  82 : os/cpu ( builder -- string )
  83     [ os>> ] [ cpu>> ] bi "/" glue ;
  84
  85 : mason-db ( -- db ) "~/mason.db" <sqlite-db> ;
  86
  87 : with-mason-db ( quot -- )
  88     mason-db [ with-transaction ] with-db ; inline
  89
  90 : init-mason-db ( -- )
  91     { builder counter } ensure-tables ;