Megatest

Check-in [1eb20fd535]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Outlined delta get run and tests method
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | newdashboard
Files: files | file ages | folders
SHA1: 1eb20fd53587186f1a2355840d6b0ad8b847c780
User & Date: matt on 2013-03-13 22:10:37
Other Links: branch diff | manifest | tags
Context
2013-03-14
00:32
Data syncs from server to dashboard but CPU load is too high check-in: 95f5714070 user: matt tags: newdashboard
2013-03-13
22:10
Outlined delta get run and tests method check-in: 1eb20fd535 user: matt tags: newdashboard
18:00
Added new files from re-factoring dashboard code check-in: 2e5af83c88 user: mrwellan tags: newdashboard
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [3f5b2d2f50] to [d7321ee147].

︙
751
752
753
754
755
756
757
758

759
760
761

762
763
764
765
766
767
768

751
752
753
754
755
756
757

758



759
760
761
762
763
764
765
766








-
+
-
-
-
+








;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN
;; i.e. these lists define what to NOT show.
;; states and statuses are required to be lists, empty is ok
;; not-in #t = above behaviour, #f = must match
;; run-ids is a list of run-ids or a single number
(define (db:get-tests-for-runs db run-ids testpatt states statuses 
			      #!key (not-in #t)
			      (sort-by #f) ;; 'rundir 'event_time
			      (sort-by #f)) ;; 'rundir 'event_time
			      (keypatts #f)
			      )
  (debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
  (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
  (let* ((res '())
	 ;; if states or statuses are null then assume match all when not-in is false
	 (states-qry      (if (null? states) 
			      #f
			      (conc " state "  
				    (if not-in "NOT" "") 
				    " IN ('"
︙
777
778
779
780
781
782
783
784

785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801

802
803
804
805
806
807
808

775
776
777
778
779
780
781

782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798

799
800
801
802
803
804
805
806








-
+
















-
+








				    "')")))
	 (tests-match-qry (tests:match->sqlqry testpatt))
	 (qry             (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment "
				" FROM tests WHERE " 
				(if run-ids
				    (if (list? run-ids)
					(conc " run_id in (" (string-intersperse (map conc run-ids) ",") ") ")
					(conc "run_id=" run-id " "))
					(conc "run_id=" run-ids " "))
				    " ") ;; #f => run-ids don't filter on run-ids
				(if states-qry   (conc " AND " states-qry)   "")
				(if statuses-qry (conc " AND " statuses-qry) "")
				(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
				(case sort-by
				  ((rundir)     " ORDER BY length(rundir) DESC;")
				  ((event_time) " ORDER BY event_time ASC;")
				  (else         ";"))
			 )))
    (debug:print-info 8 "db:get-tests-for-run qry=" qry)
    (sqlite3:for-each-row 
     (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
       (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
     db 
     qry
     )
    (debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
    (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by)
    res))

;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db test-id)
  ;; Breaking it into two queries for better file access interleaving
  (let* ((tdb (db:open-test-db-by-test-id db test-id)))
    ;; test db's can go away - must check every time
︙

Modified newdashboard.scm from [61d4d838fb] to [bd9e7cef68].

︙
371
372
373
374
375
376
377
378
379
380









381
382
383
384
385
386







387
388
389
390
391
392

393
394
395

371
372
373
374
375
376
377



378
379
380
381
382
383
384
385
386
387
388




389
390
391
392
393
394
395
396

397
398
399

400
401
402
403








-
-
-
+
+
+
+
+
+
+
+
+


-
-
-
-
+
+
+
+
+
+
+

-



-
+




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

;; TO-DO
;;  1. Make "data" hash-table hierarchial store of all displayed data
;;  2. Update synchash to understand "get-runs", "get-tests" etc.
;;  3. Add extraction of filters to synchash calls
;;
(define (run-update data filters)
  (synchash:client-get db:get-runs  "get-runs"  data filters)
  (synchash:client-get db:get-tests "get-tests" data filters))
(define (run-update data runname keypatts testpatt states statuses)
  (let ((run-ids '()))
    ;; count and offset => #f so not used
    ;; the synchash calls modify the "data" hash
    (synchash:client-get 'db:get-runs  "get-runs" (length keypatts) data runname #f #f keypatts)
    ;; Now can calculate the run-ids
    (let* ((run-hash (hash-table-ref/default data "get-runs" #f))
	   (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())))
      (synchash:client-get 'db:get-tests-for-runs "get-tests-for-runs" 0 data run-ids testpatt states statuses))))

(define (newdashboard)
  (let* ((data    (make-hash-table))
	 (filters (make-hash-table))
	 (keys    (cdb:remote-run db:get-keys #f))
	 (keyvals (map (lambda (k)(list (vector-ref k 0) "%")) keys)))
  (let* ((data     (make-hash-table))
	 (keys     (cdb:remote-run db:get-keys #f))
	 (runname  "%")
	 (testpatt "%")
	 (keypatts (map (lambda (k)(list (vector-ref k 0) "%")) keys))
	 (states   '())
	 (statuses '()))
    (iup:show (main-panel))
    ;; (set! uidat (make-dashboard-buttons *num-runs* *num-tests* *dbkeys*))
    (iup:callback-set! *tim*
		       "ACTION_CB"
		       (lambda (x)
			 (run-update rundata keyvals)))))
			 (run-update data runname keypatts testpatt states statuses)))))

(newdashboard)    
(iup:main-loop)

Modified synchash.scm from [570e33d1fe] to [fc621c950a].

︙
54
55
56
57
58
59
60



61
62

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

81
82



















83
84
85
86
87

88

54
55
56
57
58
59
60
61
62
63
64

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

109
110








+
+
+

-
+


















+

-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+


	     (hash-table-delete! synchash id))))
     orig-keys)
    (list changed deleted)))
    
;; (cdb:remote-run db:get-keys #f)  
;; (cdb:remote-run db:get-num-runs #f "%")
;; (cdb:remote-run db:get-runs #f runnamepatt numruns *start-run-offset* keypatts)
;;
;; keynum => the field to use as the unique key (usually 0 but can be other field)
;;
(define (synchash:client-get proc synckey keynum synchash . params)
  (let* ((data   (apply cdb:remote-run synchash:server-get #f proc synckey params))
  (let* ((data   (apply cdb:remote-run synchash:server-get #f proc synckey keynum params))
	 (newdat (car data))
	 (removs (cadr data)))
    (for-each 
     (lambda (item)
       (let ((id  (car item))
	     (dat (cadr item)))
	 (hash-table-set! synchash id dat)))
     newdat)
    (for-each
     (lambda (id)
       (hash-table-delete! synchash id))
     removs)
    synchash))


(define *synchashes* (make-hash-table))

(define (synchash:server-get db proc synckey keynum . params)
  (debug:print 2 "synckey: " synckey ", keynum: " keynum ", params: " params)
  (let* ((synchash (hash-table-ref/default *synchashes* synckey #f))
	 (newdat   (apply proc db params)))
	 (newdat   (apply (case proc
			    ((db:get-runs) db:get-runs)
			    ((db:get-tests-for-runs) db:get-tests-for-runs)
			    (else print))
			  db params))
	 (postdat  #f)
	 (make-indexed (lambda (x)
			 (list (vector-ref x keynum) x))))
    ;; Now process newdat based on the query type
    (set! postdat (case proc
		    ((db:get-runs)
		     (debug:print 2 "Get runs call")
		     (let ((header (vector-ref newdat 0))
			   (data   (vector-ref newdat 1)))
		       (list (list "header" header)         ;; add the header keyed by the word "header"
			     (map make-indexed data))))        ;; add each element keyed by the keynum'th val
		    (else 
		     (debug:print 2 "Non-get runs call")
		     (map make-indexed newdat))))
    (if (not synchash)
	(begin
	  (set! synchash (make-hash-table))
	  (hash-table-set! *synchashes* synckey synchash)))
    (synchash:get-delta newdat synchash)))
    (synchash:get-delta postdat synchash)))

This page was generated in about 0.108s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00