Megatest

Diff
Login

Differences From Artifact [c50dc3ce24]:

To Artifact [a59a7c6f2f]:


1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
                              id           INTEGER PRIMARY KEY,
                              test_id      INTEGER,
                              state        TEXT DEFAULT 'new',
                              status       TEXT DEFAULT 'n/a',
                              archive_type TEXT DEFAULT 'bup',
                              du           INTEGER,
                              archive_path TEXT);")))
         (print "creating triggers from init") 
        (db:create-triggers db)    
     db)) ;; )

;;======================================================================
;; A R C H I V E S
;;======================================================================

;; dneeded is minimum space needed, scan for existing archives that 
;; are on disks with adequate space and already have this test/itempath







|
|
|







1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
                              id           INTEGER PRIMARY KEY,
                              test_id      INTEGER,
                              state        TEXT DEFAULT 'new',
                              status       TEXT DEFAULT 'n/a',
                              archive_type TEXT DEFAULT 'bup',
                              du           INTEGER,
                              archive_path TEXT);")))
    (debug:print 0 *default-log-port* "creating triggers from init")
    (db:create-triggers db)    
    db)) ;; )

;;======================================================================
;; A R C H I V E S
;;======================================================================

;; dneeded is minimum space needed, scan for existing archives that 
;; are on disks with adequate space and already have this test/itempath
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042

(define (db:set-run-state-status dbstruct run-id state status )
  (db:with-db
   dbstruct #f #f
   (lambda (db)
          (sqlite3:execute db "UPDATE runs SET status=?,state=? WHERE id=?;" status state run-id))))



(define (db:get-run-status dbstruct run-id)
  (let ((res "n/a"))
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       (sqlite3:for-each-row 
	(lambda (status)







<
<







3027
3028
3029
3030
3031
3032
3033


3034
3035
3036
3037
3038
3039
3040

(define (db:set-run-state-status dbstruct run-id state status )
  (db:with-db
   dbstruct #f #f
   (lambda (db)
          (sqlite3:execute db "UPDATE runs SET status=?,state=? WHERE id=?;" status state run-id))))



(define (db:get-run-status dbstruct run-id)
  (let ((res "n/a"))
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       (sqlite3:for-each-row 
	(lambda (status)
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288

4289



4290
4291
4292
4293
4294
4295
4296
4297
4298
	(list newstate newstatus))))

(define (db:set-state-status-and-roll-up-run dbstruct run-id curr-state curr-status)
  ;; (mutex-lock! *db-transaction-mutex*)
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       (let ((tr-res
              (sqlite3:with-transaction
               db
               (lambda ()
                 (let* ((state-status-counts  (db:get-all-state-status-counts-for-run dbstruct run-id))
			(state-statuses       (db:roll-up-rules state-status-counts #f #f ))
                        (newstate             (car state-statuses))
                        (newstatus            (cadr state-statuses))) 
                   (if (or (not (eq? newstate curr-state)) (not (eq?  newstatus curr-status)))

                       (db:set-run-state-status dbstruct run-id newstate newstatus )))))))



         ;; (mutex-unlock! *db-transaction-mutex*)
         tr-res))))


(define (db:get-all-state-status-counts-for-run dbstruct run-id)
 (let* ((test-count-recs (db:with-db
                          dbstruct #f #f
                          (lambda (db)
                            (sqlite3:map-row







|








>
|
>
>
>

|







4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
	(list newstate newstatus))))

(define (db:set-state-status-and-roll-up-run dbstruct run-id curr-state curr-status)
  ;; (mutex-lock! *db-transaction-mutex*)
    (db:with-db
     dbstruct #f #f
     (lambda (db)
;;       (let ((tr-res
              (sqlite3:with-transaction
               db
               (lambda ()
                 (let* ((state-status-counts  (db:get-all-state-status-counts-for-run dbstruct run-id))
			(state-statuses       (db:roll-up-rules state-status-counts #f #f ))
                        (newstate             (car state-statuses))
                        (newstatus            (cadr state-statuses))) 
                   (if (or (not (eq? newstate curr-state)) (not (eq?  newstatus curr-status)))
                       (begin
			 (db:set-run-state-status dbstruct run-id newstate newstatus)
			 #t) ;; changes made
		       #f) ;; no changes
		   ))))))
         ;; (mutex-unlock! *db-transaction-mutex*)
;;          tr-res))))


(define (db:get-all-state-status-counts-for-run dbstruct run-id)
 (let* ((test-count-recs (db:with-db
                          dbstruct #f #f
                          (lambda (db)
                            (sqlite3:map-row