Megatest

    testmeta-update-field

    ;; TASKS
    tasks-add
    tasks-set-state-given-param-key
    ))

;; These are called by the server on receipt of /api calls
;;    - keep it simple, only return the actual result of the call, i.e. no meta info here
;;
;;    - returns #( flag result )
;;
(define (api:execute-requests dbstruct dat)
  (handle-exceptions
   exn
   (let ((call-chain (get-call-chain)))
     (debug:print 0 *default-log-port* "------------------------------")
     (debug:print 0 *default-log-port* "WARNING: api:execute-requests received an exception from peer")
     (debug:print 0 *default-log-port* "dbstruct="dbstruct"  dat="dat)
     (print-call-chain (current-error-port))
     (debug:print 0 *default-log-port* " message: "  ((condition-property-accessor 'exn 'message) exn))
     (debug:print 0 *default-log-port* "------------------------------")
     (vector #f (vector exn call-chain dat))) ;; return some stuff for debug if an exception happens
   (if (not (vector? dat))                    ;; it is an error to not receive a vector
       (vector #f #f "remote must be called with a vector")       
       (vector                                   ;; return a vector + the returned data structure
	#t 
	(let* ((cmd-in (vector-ref dat 0))
	       (cmd    (if (symbol? cmd-in)

    ;;  (if (or (string? res)
    ;;          (list?   res)
    ;;          (number? res)
    ;;          (boolean? res))
    ;;      res 
    ;;      (list "ERROR, not string, list, number or boolean" 1 cmd params res)))))
    (db:obj->string res transport: 'http)))

	     (common:low-noise-print 120 "over-50-parallel-api-requests"))
	(debug:print-info 0 *default-log-port* *api-process-request-count* " parallel api requests being processed in process " (current-process-id) ", throttling access"))
    (if (common:low-noise-print 120 (conc "parallel-api-requests" *max-api-process-requests*))
	(debug:print-info 0 *default-log-port* "Parallel api request count: " *api-process-request-count* " max parallel requests: " *max-api-process-requests*))
    (handle-exceptions
     exn
     (begin
       (debug:print 0 *default-log-port* "------------------------------")
       (print-call-chain (current-error-port))
       (debug:print-error 0 *default-log-port* "sqlite3 issue in db:with-db, dbstruct=" dbstruct ", run-id=" run-id ", proc=" proc ", params=" params " error: " ((condition-property-accessor 'exn 'message) exn))
       ;; there is no recovering at this time. exit
       (set! *time-to-exit* #t)
       (debug:print 0 *default-log-port* "------------------------------")
       (exit 50))
     (if use-mutex (mutex-lock! *db-with-db-mutex*))
     (let ((res (apply proc db params)))
       (if use-mutex (mutex-unlock! *db-with-db-mutex*))
       ;; (if (vector? dbstruct)(db:done-with dbstruct run-id r/w))
       (stack-push! (dbr:dbstruct-dbstack dbstruct) dbdat)
       res))))

  (if (dbr:dbstruct? dbstruct)
      (begin
        ;; (db:sync-touched dbstruct 0 force-sync: #t) ;; NO. Do not do this here. Instead we rely on a server to be started when there are writes, even if the server itself is not going to be used as a server.
        (let ((tdbs (map db:dbdat-get-db 
                         (stack->list (dbr:dbstruct-dbstack dbstruct))))
              (mdb (db:dbdat-get-db (dbr:dbstruct-mtdb   dbstruct)))
              (rdb (db:dbdat-get-db (dbr:dbstruct-refndb dbstruct))))
          (map
           (lambda (db)
             (handle-exception
              exn
              (begin
                (debug:print 0 *default-log-port* "------------------------------")
                (debug:print 0 *default-log-port* "EXCEPTION: stack db database finalize failed: "db)
                (print-call-chain (current-error-port))
                (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
                (debug:print 0 *default-log-port* "------------------------------"))
              (sqlite3:finalize! db)))
           tdbs)
          
          (handle-exception
           exn
           (begin
             (debug:print 0 *default-log-port* "------------------------------")
             (debug:print 0 *default-log-port* "EXCEPTION: mdb database finalize failed.")
             (print-call-chain (current-error-port))
             (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
             (debug:print 0 *default-log-port* "------------------------------"))
           (if mdb (sqlite3:finalize! mdb)))

          (handle-exception
           exn
           (begin
             (debug:print 0 *default-log-port* "------------------------------")
             (debug:print 0 *default-log-port* "EXCEPTION: rdb database finalize failed.")
             (print-call-chain (current-error-port))
             (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
             (debug:print 0 *default-log-port* "------------------------------"))
           (if rdb (sqlite3:finalize! rdb)))))))
  
;;   (let ((locdbs (dbr:dbstruct-locdbs dbstruct)))
;;     (if (hash-table? locdbs)
;; 	(for-each (lambda (run-id)
;; 		    (db:close-run-db dbstruct run-id))
;; 		  (hash-table-keys locdbs)))))

	"SELECT state,status,count(id) AS count FROM tests WHERE run_id=? AND NOT(uname='n/a' AND item_path='') GROUP BY state,status;"
	run-id))))

;; Update run_stats for given run_id
;; input data is a list (state status count)
;;
(define (db:update-run-stats dbstruct run-id stats)
  (mutex-lock! *db-transaction-mutex*)
  (db:with-db
   dbstruct
   #f
   #f

   (lambda (db)
     ;; remove previous data

		(for-each
		 (lambda (dat)
		   (sqlite3:execute stmt1 run-id (car dat)(cadr dat))
		   (apply sqlite3:execute stmt2 run-id dat))
		 stats)))))
       (sqlite3:finalize! stmt1)
       (sqlite3:finalize! stmt2)
       (mutex-unlock! *db-transaction-mutex*)
       res))))

(define (db:get-main-run-stats dbstruct run-id)
  (db:with-db
   dbstruct
   #f ;; this data comes from main
   #f

			   (db:test-get-testname testdat)
			   test-name))
	 (item-path    (db:test-get-item-path testdat))
         (tl-testdat   (db:get-test-info dbstruct run-id test-name ""))
         (tl-test-id   (db:test-get-id tl-testdat)))
    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
	(db:general-call dbstruct 'set-test-start-time (list test-id)))
    (mutex-lock! *db-transaction-mutex*)
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       (let ((tr-res
              (sqlite3:with-transaction
               db
               (lambda ()

                                                       "COMPLETED"
                                                       (car all-curr-states))))
                            (newstatus         (if (> bad-not-started 0)
                                                   "CHECK"
                                                   (car all-curr-statuses))))
                       ;; (print "Setting toplevel to: " newstate "/" newstatus)
                       (db:test-set-state-status dbstruct run-id tl-test-id newstate newstatus #f)))))))
         (mutex-unlock! *db-transaction-mutex*)
         (if (and test-id state status (equal? status "AUTO")) 
             (db:test-data-rollup dbstruct run-id test-id status))
         tr-res)))))

(define (db:get-all-state-status-counts-for-test dbstruct run-id test-name item-path)
  (db:with-db
   dbstruct #f #f