Index: cgisetup/models/pgdb.scm ================================================================== --- cgisetup/models/pgdb.scm +++ cgisetup/models/pgdb.scm @@ -90,10 +90,37 @@ (print-call-chain) (debug:print 0 *default-log-port* "ERROR: cannot create ttype entry, " ((condition-property-accessor 'exn 'message) exn)) #f) (dbi:exec dbh "INSERT INTO ttype (target_spec) VALUES (?);" target-spec)) (pgdb:get-ttype dbh target-spec))))) + +;;====================================================================== +;; T A G S +;;====================================================================== + + +(define (pgdb:get-tag-info-by-name dbh tag) + (dbi:get-one-row dbh "SELECT id,tag_name FROM tags where tag_name=?;" tag)) + +(define (pgdb:insert-tag dbh name ) + (dbi:exec dbh "INSERT INTO tags (tag_name) VALUES (?)" name )) + +(define (pgdb:insert-area-tag dbh tag-id area-id ) + (dbi:exec dbh "INSERT INTO area_tags (tag_id, area_id) VALUES (?,?)" tag-id area-id )) + +(define (pgdb:is-area-taged dbh area-id) + (let ((area-tag-id (dbi:get-one dbh "SELECT id FROM area_tags WHERE area_id=?;" area-id))) + (if area-tag-id + #t + #f))) + +(define (pgdb:is-area-taged-with-a-tag dbh tag-id area-id) + (let ((area-tag-id (dbi:get-one dbh "SELECT id FROM area_tags WHERE area_id=? and tag_id=?;" area-id tag-id))) + (if area-tag-id + #t + #f))) + ;;====================================================================== ;; R U N S ;;====================================================================== Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -114,10 +114,11 @@ (define *passnum* 0) ;; when running track calls to run-tests or similar ;; (define *alt-log-file* #f) ;; used by -log (define *common:denoise* (make-hash-table)) ;; for low noise printing (define *default-log-port* (current-error-port)) (define *time-zero* (current-seconds)) ;; for the watchdog +(define *default-area-tag* "local") ;; DATABASE (define *dbstruct-db* #f) ;; used to cache the dbstruct in db:setup. Goal is to remove this. ;; db stats (define *db-stats* (make-hash-table)) ;; hash of vectors < count duration-total > Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -170,10 +170,11 @@ -testdata-csv [categorypatt/]varpatt : dump testdata for given category Misc -start-dir path : switch to this directory before running megatest -contour cname : add a level of hierarcy to the linktree and run paths + -area-tag tagname : add a tag to an area while syncking to pgdb -rebuild-db : bring the database schema up to date -cleanup-db : remove any orphan records, vacuum the db -import-megatest.db : push data from megatest.db to cache db files in /tmp/$USER -sync-to-megatest.db : pull data from cache files in /tmp/$USER to megatest.db -sync-to dest : sync to new postgresql central style database @@ -278,10 +279,11 @@ ":tol" ":units" ;; misc "-start-dir" "-contour" + "-area-tag" "-server" "-transport" "-port" "-extract-ods" "-pathmod" Index: mt-pg.sql ================================================================== --- mt-pg.sql +++ mt-pg.sql @@ -41,10 +41,21 @@ area_name TEXT NOT NULL, area_path TEXT NOT NULL, last_sync INTEGER DEFAULT 0, CONSTRAINT areaconstraint UNIQUE (area_name)); +CREATE TABLE IF NOT EXISTS tags ( + id SERIAL PRIMARY KEY, + tag_name TEXT NOT NULL, + CONSTRAINT tagconstraint UNIQUE (tag_name)); + +CREATE TABLE IF NOT EXISTS area_tags ( + id SERIAL PRIMARY KEY, + tag_id INTEGER DEFAULT 0, + area_id INTEGER DEFAULT 0, + CONSTRAINT areatagconstraint UNIQUE (tag_id, area_id)); + INSERT INTO areas (id,area_name,area_path) VALUES (0,'local','.'); CREATE TABLE IF NOT EXISTS ttype ( id SERIAL PRIMARY KEY, target_spec TEXT DEFAULT ''); Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -794,10 +794,31 @@ (set! pgdb-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path)))) (hash-table-set! test-ht test-id pgdb-test-id)) (print "WARNING: Skipping run with run-id:" run-id ". This run was created after privious sync and removed before this sync.")))) test-ids))) +(define (task:add-area-tag dbh area-info tag) + (let* ((tag-info (pgdb:get-tag-info-by-name dbh tag))) + (if (not tag-info) + (begin + (if (handle-exceptions + exn + (begin + (print ((condition-property-accessor 'exn 'message) exn)) + #f) + (pgdb:insert-tag dbh tag)) + (set! tag-info (pgdb:get-tag-info-by-name dbh tag)) + #f))) + ;;add to area_tags + (handle-exceptions + exn + (begin + (print ((condition-property-accessor 'exn 'message) exn)) + #f) + (if (not (pgdb:is-area-taged-with-a-tag dbh (vector-ref tag-info 0) (vector-ref area-info 0))) + (pgdb:insert-area-tag dbh (vector-ref tag-info 0) (vector-ref area-info 0)))))) + ;; get runs changed since last sync ;; (define (tasks:sync-test-data dbh cached-info area-info) ;; (let* (( (define (tasks:sync-to-postgres configdat dest) @@ -814,13 +835,19 @@ (changed (rmt:get-changed-record-ids last-sync-time)) (run-ids (alist-ref 'runs changed)) (test-ids (alist-ref 'tests changed)) (test-step-ids (alist-ref 'test_steps changed)) (test-data-ids (alist-ref 'test_data changed)) - (run-stat-ids (alist-ref 'run_stats changed))) - (print "area-info: " area-info) - + (run-stat-ids (alist-ref 'run_stats changed)) + (area-tag (if (args:get-arg "-area-tag") + (args:get-arg "-area-tag") + ""))) + ; (print "area-info: " area-info) + (if (and (equal? area-tag "") (not (pgdb:is-area-taged dbh (vector-ref area-info 0)))) + (set! area-tag *default-area-tag*)) + (if (not (equal? area-tag "")) + (task:add-area-tag dbh area-info area-tag)) (if (not (null? test-ids)) (begin (print "Syncing " (length test-step-ids) " changed tests") ;;Assumption here is that if test-step or test data is changed then the test last update time is changed ;; not syncing run stats at this time as they can be derived from tests table.