Overview
Comment: | Nada |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
1c292f6f90a1acb917c8980593b4b3a8 |
User & Date: | mrwellan on 2011-10-27 20:31:17 |
Other Links: | manifest | tags |
Context
2011-10-29
| ||
21:51 | Fixed test of eztest with logpro check-in: bc64078220 user: matt tags: trunk | |
2011-10-27
| ||
20:31 | Nada check-in: 1c292f6f90 user: mrwellan tags: trunk | |
2011-10-26
| ||
14:03 | Merged guitweaks (includes stuff from private branches check-in: bb8b14dea5 user: mrwellan tags: trunk | |
Changes
Modified dashboard.scm from [f724b05dae] to [31da9fd56a].
︙ | ︙ | |||
280 281 282 283 284 285 286 | ;; sort by second field (vlst-s1 (sort vlst (lambda (a b) (let ((astr (vector-ref a 1)) (bstr (vector-ref b 1))) (if (string=? astr "") #f #t))))) ;; (>= (string-length (vector-ref a 1))(string-length (vector-ref b 1)))))) (vlst-s2 (sort vlst-s1 (lambda (a b) | | | 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 | ;; sort by second field (vlst-s1 (sort vlst (lambda (a b) (let ((astr (vector-ref a 1)) (bstr (vector-ref b 1))) (if (string=? astr "") #f #t))))) ;; (>= (string-length (vector-ref a 1))(string-length (vector-ref b 1)))))) (vlst-s2 (sort vlst-s1 (lambda (a b) (string>= (vector-ref a 0)(vector-ref b 0)))))) (map (lambda (x) (if (equal? (vector-ref x 1) "") (vector-ref x 0) (conc (vector-ref x 0) "(" (vector-ref x 1) ")"))) vlst-s2))) ;; (sort newlst (lambda (a b) |
︙ | ︙ |
Modified task_records.scm from [44007a614c] to [634fd98234].
1 2 3 4 5 6 7 8 9 10 11 | ;;====================================================================== ;; 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. ;;====================================================================== | | | > | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | ;;====================================================================== ;; 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 params creation_time execution_time (define (make-tasks:task)(make-vector 11)) (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-params vec) (vector-ref vec 8)) (define-inline (tasks:task-get-creation_time vec) (vector-ref vec 9)) (define-inline (tasks:task-get-execution_time vec) (vector-ref vec 10)) (define-inline (tasks:task-set-state! vec val)(vector-set! vec 3 val)) ;; make-vector-record tasks monitor id pid start_time last_update hostname username (define (make-tasks:monitor)(make-vector 5)) (define-inline (tasks:monitor-get-id vec) (vector-ref vec 0)) |
︙ | ︙ |
Modified tasks.scm from [0bafc39e74] to [e24a437d48].
︙ | ︙ | |||
35 36 37 38 39 40 41 42 43 44 45 46 47 48 | owner TEXT, state TEXT DEFAULT 'new', target TEXT DEFAULT '', name TEXT DEFAULT '', test TEXT DEFAULT '', item TEXT DEFAULT '', keylock TEXT, creation_time TIMESTAMP, execution_time TIMESTAMP);") (sqlite3:execute tdb "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY, pid INTEGER, start_time TIMESTAMP, last_update TIMESTAMP, hostname TEXT, | > | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | owner TEXT, state TEXT DEFAULT 'new', target TEXT DEFAULT '', name TEXT DEFAULT '', test TEXT DEFAULT '', item TEXT DEFAULT '', keylock TEXT, params TEXT, creation_time TIMESTAMP, execution_time TIMESTAMP);") (sqlite3:execute tdb "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY, pid INTEGER, start_time TIMESTAMP, last_update TIMESTAMP, hostname TEXT, |
︙ | ︙ | |||
82 83 84 85 86 87 88 | (set! res count)) tdb "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;" (car (user-information (current-user-id)))) res)) ;; register a task | | | | > | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | (set! res count)) tdb "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;" (car (user-information (current-user-id)))) res)) ;; register a task (define (tasks:add tdb action owner target runname test item params) (sqlite3:execute tdb "INSERT INTO tasks_queue (action,owner,state,target,name,test,item,params,creation_time,execution_time) VALUES (?,?,'new',?,?,?,?,strftime('%s','now'),0);" action owner target runname test item (if params params ""))) (define (keys:key-vals-hash->target keys key-params) (let ((tmp (hash-table-ref/default key-params (vector-ref (car keys) 0) ""))) (if (> (length keys) 1) (for-each (lambda (key) (set! tmp (conc tmp "/" (hash-table-ref/default key-params (vector-ref key 0) "")))) (cdr keys))) |
︙ | ︙ | |||
129 130 131 132 133 134 135 | state='reset' ORDER BY RANDOM() LIMIT 1);" keytxt) (sqlite3:for-each-row (lambda (id . rem) (set! res (apply vector id rem))) tdb | | | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | state='reset' ORDER BY RANDOM() LIMIT 1);" keytxt) (sqlite3:for-each-row (lambda (id . rem) (set! res (apply vector id rem))) tdb "SELECT id,action,owner,state,target,name,test,item,params,creation_time,execution_time FROM tasks_queue WHERE keylock=? ORDER BY execution_time ASC LIMIT 1;" keytxt) (if res ;; yep, have work to be done (begin (sqlite3:execute tdb "UPDATE tasks_queue SET state='inprogress',execution_time=strftime('%s','now') WHERE id=?;" (tasks:task-get-id res)) res) #f))) |
︙ | ︙ | |||
156 157 158 159 160 161 162 | ;; (define (tasks:get-tasks tdb types states) (let ((res '())) (sqlite3:for-each-row (lambda (id . rem) (set! res (cons (apply vector id rem) res))) tdb | | | 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | ;; (define (tasks:get-tasks tdb types states) (let ((res '())) (sqlite3:for-each-row (lambda (id . rem) (set! res (cons (apply vector id rem) res))) tdb (conc "SELECT id,action,owner,state,target,name,test,item,params,creation_time,execution_time FROM tasks_queue " ;; WHERE ;; state IN " statesstr " AND ;; action IN " actionsstr " ORDER BY creation_time DESC;")) res)) |
︙ | ︙ | |||
215 216 217 218 219 220 221 | (set! res (cons (apply vector a rem) res))) tdb "SELECT id,pid,strftime('%m/%d/%Y %H:%M',datetime(start_time,'unixepoch'),'localtime'),strftime('%m/%d/%Y %H:%M:%S',datetime(last_update,'unixepoch'),'localtime'),hostname,username FROM monitors ORDER BY last_update ASC;") (reverse res) )) (define (tasks:tasks->text tasks) | | | | > | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 | (set! res (cons (apply vector a rem) res))) tdb "SELECT id,pid,strftime('%m/%d/%Y %H:%M',datetime(start_time,'unixepoch'),'localtime'),strftime('%m/%d/%Y %H:%M:%S',datetime(last_update,'unixepoch'),'localtime'),hostname,username FROM monitors ORDER BY last_update ASC;") (reverse res) )) (define (tasks:tasks->text tasks) (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~12a~10a")) (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "itempatts" "params") "\n" (string-intersperse (map (lambda (task) (format #f fmtstr (tasks:task-get-id task) (tasks:task-get-action task) (tasks:task-get-owner task) (tasks:task-get-state task) (tasks:task-get-target task) (tasks:task-get-name task) (tasks:task-get-test task) (tasks:task-get-item task) (tasks:task-get-params task))) tasks) "\n")))) (define (tasks:monitors->text-table monitors) (let ((fmtstr "~4a~8a~20a~20a~10a~10a")) (conc (format #f fmtstr "id" "pid" "start time" "last update" "hostname" "user") "\n" (string-intersperse (map (lambda (monitor) |
︙ | ︙ | |||
281 282 283 284 285 286 287 288 289 290 291 292 293 294 | ;; NOTE: It might be good to add one more layer of checking to ensure ;; that no task gets run in parallel. (define (tasks:start-run db tdb task) (let ((flags (make-hash-table))) (hash-table-set! flags "-rerun" "NOT_STARTED") (print "Starting run " task) ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY (runs:run-tests db (tasks:task-get-target task) (tasks:task-get-name task) (tasks:task-get-test task) (tasks:task-get-item task) | > > | 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | ;; NOTE: It might be good to add one more layer of checking to ensure ;; that no task gets run in parallel. (define (tasks:start-run db tdb task) (let ((flags (make-hash-table))) (hash-table-set! flags "-rerun" "NOT_STARTED") (if (not (string=? (tasks:task-get-params task) "")) (hash-table-set! flags "- (print "Starting run " task) ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY (runs:run-tests db (tasks:task-get-target task) (tasks:task-get-name task) (tasks:task-get-test task) (tasks:task-get-item task) |
︙ | ︙ |