Index: common_records.scm ================================================================== --- common_records.scm +++ common_records.scm @@ -1,5 +1,16 @@ +;;====================================================================== +;; Copyright 2006-2011, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. +;;====================================================================== + (define-inline (debug:print n . params) (if (<= n *verbosity*) (apply print params))) ;; if a value is printable (i.e. string or number) return the value Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -126,12 +126,26 @@ units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', type TEXT DEFAULT '', CONSTRAINT test_data UNIQUE (test_id,category,variable));") - ;; (sqlite3:execute db "CREATE TABLE IF NOT EXISTS task_calls (id INTEGER PRIMARY KEY, - + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS task_queue (id INTEGER PRIMARY KEY, + action TEXT DEFAULT '', + owner TEXT, + state TEXT DEFAULT 'new', + target TEXT DEFAULT '', + name TEXT DEFAULT '', + test TEXT DEFAULT '', + item TEXT DEFAULT '', + creation_time TIMESTAMP, + execution_time TIMESTAMP;") + (sqlite3:execute db "CREATE monitors (id INTEGER PRIMARY KEY, + pid INTEGER, + start_time TIMESTAMP, + last_update TIMESTAMP, + hostname TEXT, + username TEXT);") ;; Must do this *after* running patch db !! No more. (db:set-var db "MEGATEST_VERSION" megatest-version) )) db)) Index: docs/megatest.lyx ================================================================== --- docs/megatest.lyx +++ docs/megatest.lyx @@ -1542,11 +1542,11 @@ A flow specifies the tests to run, the order and dependencies and is managed by a running megatest process. \end_layout \begin_layout Section -Flow Specification and Running +Flow Specification and Running (Not released yet) \end_layout \begin_layout Subsection Write your flow file \end_layout @@ -1663,10 +1663,27 @@ \begin_layout Plain Layout megatest -runflow :FIELD1 val1 :FIELD2 val2 :runname wk32.4 \end_layout +\end_inset + + +\end_layout + +\begin_layout Section +Monitor based running +\end_layout + +\begin_layout Subsection +Monitor logic +\end_layout + +\begin_layout Standard +\begin_inset Graphics + filename monitor-state-diagram.svg + \end_inset \end_layout Index: key_records.scm ================================================================== --- key_records.scm +++ key_records.scm @@ -1,5 +1,16 @@ +;;====================================================================== +;; Copyright 2006-2011, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. +;;====================================================================== + (define-inline (key:get-fieldname key)(vector-ref key 0)) (define-inline (key:get-fieldtype key)(vector-ref key 1)) (define-inline (keys->valslots keys) ;; => ?,?,? .... (string-intersperse (map (lambda (x) "?") keys) ",")) Index: run_records.scm ================================================================== --- run_records.scm +++ run_records.scm @@ -1,5 +1,16 @@ +;;====================================================================== +;; Copyright 2006-2011, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. +;;====================================================================== + (define-inline (test:get-id vec) (vector-ref vec 0)) (define-inline (test:get-run_id vec) (vector-ref vec 1)) (define-inline (test:get-test-name vec)(vector-ref vec 2)) (define-inline (test:get-state vec) (vector-ref vec 3)) (define-inline (test:get-status vec) (vector-ref vec 4)) ADDED task_records.scm Index: task_records.scm ================================================================== --- /dev/null +++ task_records.scm @@ -0,0 +1,32 @@ +;;====================================================================== +;; Copyright 2006-2011, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. +;;====================================================================== + +;; make-vector-record tasks task id action owner state target name test item creation_time execution_time +(define (make-tasks:task)(make-vector 10)) +(define-inline (tasks:task-get-id vec) (vector-ref vec 0)) +(define-inline (tasks:task-get-action vec) (vector-ref vec 1)) +(define-inline (tasks:task-get-owner vec) (vector-ref vec 2)) +(define-inline (tasks:task-get-state vec) (vector-ref vec 3)) +(define-inline (tasks:task-get-target vec) (vector-ref vec 4)) +(define-inline (tasks:task-get-name vec) (vector-ref vec 5)) +(define-inline (tasks:task-get-test vec) (vector-ref vec 6)) +(define-inline (tasks:task-get-item vec) (vector-ref vec 7)) +(define-inline (tasks:task-get-creation_time vec) (vector-ref vec 8)) +(define-inline (tasks:task-get-execution_time vec) (vector-ref vec 9)) + + +;; make-vector-record tasks monitor pid start_time last_update hostname username +(define (make-tasks:monitor)(make-vector 5)) +(define-inline (tasks:monitor-get-pid vec) (vector-ref vec 0)) +(define-inline (tasks:monitor-get-start_time vec) (vector-ref vec 1)) +(define-inline (tasks:monitor-get-last_update vec) (vector-ref vec 2)) +(define-inline (tasks:monitor-get-hostname vec) (vector-ref vec 3)) +(define-inline (tasks:monitor-get-username vec) (vector-ref vec 4)) ADDED tasks.scm Index: tasks.scm ================================================================== --- /dev/null +++ tasks.scm @@ -0,0 +1,112 @@ +;; Copyright 2006-2011, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. + +;; strftime('%m/%d/%Y %H:%M:%S','now','localtime') + +(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking) +(import (prefix sqlite3 sqlite3:)) + +(declare (unit runs)) +(declare (uses db)) +(declare (uses common)) +(declare (uses items)) +(declare (uses runconfig)) + +(include "common_records.scm") +(include "key_records.scm") +(include "db_records.scm") +(include "run_records.scm") +(include "task_records.scm") + +;;====================================================================== +;; Tasks and Task monitors +;;====================================================================== + + +;;====================================================================== +;; Tasks +;;====================================================================== + + + +;;====================================================================== +;; Task Monitors +;;====================================================================== + +(define (tasks:register-monitor db) + (let* ((pid (current-process-id)) + (hostname (get-host-name)) + (userinfo (user-information (current-user-id))) + (username (car userinfo))) + (sqlite3:execute db "INSERT INTO monitors (pid,start_time,last_update,hostname,username) VALUES (?,strftime('%s','now'),strftime('%s','now'),?,?);" + pid hostname username))) + +(define (tasks:get-num-alive-monitors db) + (let ((res 0)) + (sqlite3:for-each-row + (lambda (count) + (set! res count)) + db + "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;" + (car (user-information (current-user-id)))) + res)) + +;; return one task from those who are 'new' OR 'waiting' AND more than 10sec old +;; +(define (tasks:snag-a-task db) + (let ((res #f)) + (with-transaction + db + (lambda () + (sqlite3:for-each-row + (lambda (id . rem) + (set! res (apply vector id rem))) + db + "SELECT id,action,owner,state,target,name,test,item,creation_time,exectution_time + FROM tasks_queue + WHERE + state='new' OR (state='waiting' AND + last_update+10 > strftime('%s','now')) + LIMIT 1;") + (if res ;; yep, have work to be done + (begin + (sqlite3:execute db "UPDATE tasks_queue SET state='inprogress' WHERE id=?;" + (tasks:task-get-id res)) + res)))))) + +(define (tasks:start-monitor db) + (if (> (tasks:get-num-alive-monitors db) 2) ;; have two running, no need for more + (debug:print 1 "INFO: Not starting monitor, already have more than two running") + (let* ((megatestdb (conc *toppath* "/megatest.db")) + (last-db-update 0)) ;; (file-modification-time megatestdb))) + (task:register-monitor db) + (let loop ((count 0)) + ;; if the db has been modified we'd best look at the task queue + (let ((modtime (file-modification-time megatestdb))) + (if (> modtime last-db-update) + (let* ((task (tasks:snag-a-task db)) + (action (if task (tasks:task-get-action task) #f))) + (if action + (case (string->symbol action) + ((run) (tasks:start-run db task)) + ((remove) (tasks:remove-runs db task)) + ((lock) (tasks:lock-runs db task)) + ((monitor) (tasks:start-monitor db task)) + ((rollup) (tasks:rollup-runs db task)) + ((updatemeta)(tasks:update-meta db task)) + ((kill) (tasks:kill-monitors db task)))) + ;; WARNING: Possible race conditon here!! + ;; should this update be immediately after the task-get-action call above? + (set! modtime (file-modification-time megatestdb))))) + (loop (+ count 1)))))) + + + + +