Megatest

;;======================================================================
;; Copyright 2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit pgdb))
(declare (uses configf))

;; I don't know how to mix compilation units and modules, so no module here.
;;

		exn
		(begin
		  (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:insert-run-tag dbh tag-id run-id )
  (dbi:exec dbh "INSERT INTO run_tags (tag_id, run_id) VALUES (?,?)" tag-id run-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)))

(define (pgdb:is-run-taged-with-a-tag dbh   tag-id run-id)
   (let ((run-tag-id (dbi:get-one dbh "SELECT id FROM run_tags WHERE run_id=? and tag_id=?;" run-id tag-id)))
   (if run-tag-id 
           #t
            #f)))



;;======================================================================
;;  R U N S
;;======================================================================

;; given a target spec id, target and run-name return the run-id
;; if no run found return #f
;;
(define (pgdb:get-run-id dbh spec-id target run-name area-id)
  (dbi:get-one dbh "SELECT id FROM runs WHERE ttype_id=? AND target=? AND run_name=? and area_id=?;"
	       spec-id target run-name area-id))

;; given a target spec id, target and run-name return the run-id
;; if no run found return #f
;;
(define (pgdb:get-run-last-update dbh id )
  (dbi:get-one dbh "SELECT last_update FROM runs WHERE id=?;"
	        id))

;; given a run-id return all the run info
;;
(define (pgdb:get-run-info dbh run-id ) ;; to join ttype or not?
  (dbi:get-one-row
   dbh   ;; 0    1       2       3      4     5      6       7        8         9         10          11         12
   "SELECT id,target,ttype_id,run_name,state,status,owner,event_time,comment,fail_count,pass_count,last_update,area_id
       FROM runs WHERE id=? ;" run-id ))

;; refresh the data in a run record
;;
(define (pgdb:refresh-run-info dbh run-id state status owner event-time comment fail-count pass-count area-id last_update publish-time) ;; area-id)
  (dbi:exec
   dbh
   "UPDATE runs SET
      state=?,status=?,owner=?,event_time=?,comment=?,fail_count=?,pass_count=?,last_update=?,publish_time=?  
     WHERE id=? and area_id=?;"
   state status owner event-time comment fail-count pass-count last_update publish-time run-id area-id ))

;; given all needed info create run record
;;
(define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time)
    (dbi:exec
   dbh
   "INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count,area_id,last_update,publish_time)
      VALUES (?,?,?,?,?,?,?,?,?,?,?,?, ?);"
    ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time))

;;======================================================================
;;  T E S T - S T E P S
;;======================================================================

(define (pgdb:get-test-step-id dbh test-id stepname state)
  (dbi:get-one
    dbh
    "SELECT id FROM test_steps WHERE test_id=? AND stepname=? and state = ? ;"
    test-id stepname state))

(define (pgdb:get-test-step-last-update dbh id )
  (dbi:get-one
    dbh
    "SELECT last_update FROM test_steps WHERE id=? ;"
    id))

(define (pgdb:insert-test-step dbh test-id stepname state status event_time comment logfile last-update )
  (dbi:exec
   dbh
   "INSERT INTO test_steps (test_id,stepname,state,status,event_time,logfile,comment,last_update)
       VALUES (?,?,?,?,?,?,?,? );"
   test-id stepname  state   status  event_time   logfile   comment last-update))

(define (pgdb:update-test-step dbh step-id test-id stepname state status event_time comment logfile last-update)
  (dbi:exec
    dbh
    "UPDATE test_steps SET
         test_id=?,stepname=?,state=?,status=?,event_time=?,logfile=?,comment=?,last_update=?
          WHERE id=?;"
    test-id stepname  state   status  event_time   logfile   comment last-update step-id))


;;======================================================================
;;  T E S T - D A T A
;;======================================================================

(define (pgdb:get-test-data-id dbh test-id category variable)
  (dbi:get-one
    dbh
    "SELECT id FROM test_data WHERE test_id=? AND category=? and variable = ? ;"
    test-id category variable))

(define (pgdb:get-test-data-last-update dbh test-data-id )
  (dbi:get-one
    dbh
    "SELECT last_update FROM test_data WHERE id=? ;"
    test-data-id))

(define (pgdb:insert-test-data dbh test-id category variable value expected tol units comment status type last-update)
 ; (print "INSERT INTO test_data (test_id, category, variable, value, expected, tol, units, comment, status, type)
 ;      VALUES (?,?,?,?,?,?,?,?,?,?) " test-id " " category " " variable " " value " "  expected " "  tol " "  units " " comment  " " status  " " type)
  (if (not (string? units))
      (set! units "" ))
  (if (not (string? variable))
      (set! variable "" ))
  (if (not (real? value))
      (set! value 0 ))
  (if (not (real? expected))
      (set! expected 0  ))
(if (not (real? tol))
      (set! tol 0  ))

  (dbi:exec
   dbh
   "INSERT INTO test_data (test_id, category, variable, value, expected, tol, units, comment, status, type, last_update)
       VALUES (?,?,?,?,?,?,?,?,?,?, ?);"
   test-id category variable value expected tol units comment status type last-update))

(define (pgdb:update-test-data dbh data-id test-id  category variable value expected tol units comment status type last-update)
  (dbi:exec
    dbh
    "UPDATE test_data SET
         test_id=?, category=?, variable=?, value=?, expected=?, tol=?, units=?, comment=?, status=?, type=?, last_update=?
          WHERE id=?;"
    test-id category variable value expected tol units comment status type last-update data-id ))



;;======================================================================
;;  T E S T S
;;======================================================================

;; given run-id, test_name and item_path return test-id
;;
(define (pgdb:get-test-id dbh run-id test-name item-path)
  (dbi:get-one
   dbh
   "SELECT id FROM tests WHERE run_id=? AND test_name=? AND item_path=?;"
   run-id test-name item-path))

(define (pgdb:get-test-last-update dbh id)
  (dbi:get-one
   dbh
   "SELECT last_update FROM tests WHERE id=? ;"
   id ))


;; create new test record
;;
(define (pgdb:insert-test dbh run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update pid)
  (dbi:exec
   dbh
   "INSERT INTO tests (run_id,test_name,item_path,state,status,host,cpuload,diskfree,uname,rundir,final_logf,run_duration,comment,event_time,archived,last_update,attemptnum)
       VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);"

   run-id  test-name item-path    state   status     host  cpuload diskfree uname
   run-dir log-file  run-duration comment event-time archived last-update pid))

;; update existing test record
;;
(define (pgdb:update-test dbh test-id run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update pid)
  (dbi:exec
   dbh
   "UPDATE tests SET
      run_id=?,test_name=?,item_path=?,state=?,status=?,host=?,cpuload=?,diskfree=?,uname=?,rundir=?,final_logf=?,run_duration=?,comment=?,event_time=?,archived=?,last_update=?,attemptnum=?
    WHERE id=?;"

   run-id  test-name item-path    state   status     host  cpuload diskfree uname
   run-dir log-file  run-duration comment event-time archived last-update pid test-id))

(define (pgdb:get-tests dbh target-patt)
  (dbi:get-rows
   dbh
   "SELECT t.id,t.run_id,t.test_name,t.item_path,t.state,t.status,t.host,t.cpuload,t.diskfree,t.uname,t.rundir,t.final_logf,t.run_duration,t.comment,t.event_time,t.archived,
           r.id,r.target,r.ttype_id,r.run_name,r.state,r.status,r.owner,r.event_time,r.comment
     FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id