Megatest

Diff
Login

Differences From Artifact [54278f4e4b]:

To Artifact [4157f37338]:


28
29
30
31
32
33
34










35
36
37
38
39
40
41
(use canvas-draw)
(import canvas-draw-iup)

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))

(declare (uses configf))











(include "megatest-fossil-hash.scm")

;;
;; GLOBALS
;;
(define *datashare:current-tab-number* 0)







>
>
>
>
>
>
>
>
>
>







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
(use canvas-draw)
(import canvas-draw-iup)

(use sqlite3 srfi-1 posix regex regex-case srfi-69)
(import (prefix sqlite3 sqlite3:))

(declare (uses configf))
(declare (uses tree))
;; (declare (uses dcommon))
;; (declare (uses margs))
;; (declare (uses launch))
;; (declare (uses gutils))
;; (declare (uses db))
;; (declare (uses synchash))
;; (declare (uses server))
;; (declare (uses megatest-version))
;; (declare (uses tbd))

(include "megatest-fossil-hash.scm")

;;
;; GLOBALS
;;
(define *datashare:current-tab-number* 0)
50
51
52
53
54
55
56




































57
58
59
60
61
62
63
(i)  Uses group ownership of files to be published for group if not specified
(ii) Uses local path or looks up script to find path in configs

Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest

Version: " megatest-fossil-hash)) ;; "





































;;======================================================================
;; DB
;;======================================================================

(define (datashare:initialize-db db)
  (for-each
   (lambda (qry)







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
(i)  Uses group ownership of files to be published for group if not specified
(ii) Uses local path or looks up script to find path in configs

Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest

Version: " megatest-fossil-hash)) ;; "

;;======================================================================
;; RECORDS
;;======================================================================

;; make-vector-record "testing" datastore pkg id area version_name store_type copied source_path iteration submitter datetime storegrp datavol quality disk_id comment
;; testing
(define (make-datastore:pkg)(make-vector 14))
(define-inline (datastore:pkg-get-id             vec)    (vector-ref  vec 0))
(define-inline (datastore:pkg-get-area           vec)    (vector-ref  vec 1))
(define-inline (datastore:pkg-get-version_name   vec)    (vector-ref  vec 2))
(define-inline (datastore:pkg-get-store_type     vec)    (vector-ref  vec 3))
(define-inline (datastore:pkg-get-copied         vec)    (vector-ref  vec 4))
(define-inline (datastore:pkg-get-source_path    vec)    (vector-ref  vec 5))
(define-inline (datastore:pkg-get-iteration      vec)    (vector-ref  vec 6))
(define-inline (datastore:pkg-get-submitter      vec)    (vector-ref  vec 7))
(define-inline (datastore:pkg-get-datetime       vec)    (vector-ref  vec 8))
(define-inline (datastore:pkg-get-storegrp       vec)    (vector-ref  vec 9))
(define-inline (datastore:pkg-get-datavol        vec)    (vector-ref  vec 10))
(define-inline (datastore:pkg-get-quality        vec)    (vector-ref  vec 11))
(define-inline (datastore:pkg-get-disk_id        vec)    (vector-ref  vec 12))
(define-inline (datastore:pkg-get-comment        vec)    (vector-ref  vec 13))
(define-inline (datastore:pkg-set-id!            vec val)(vector-set! vec 0 val))
(define-inline (datastore:pkg-set-area!          vec val)(vector-set! vec 1 val))
(define-inline (datastore:pkg-set-version_name!  vec val)(vector-set! vec 2 val))
(define-inline (datastore:pkg-set-store_type!    vec val)(vector-set! vec 3 val))
(define-inline (datastore:pkg-set-copied!        vec val)(vector-set! vec 4 val))
(define-inline (datastore:pkg-set-source_path!   vec val)(vector-set! vec 5 val))
(define-inline (datastore:pkg-set-iteration!     vec val)(vector-set! vec 6 val))
(define-inline (datastore:pkg-set-submitter!     vec val)(vector-set! vec 7 val))
(define-inline (datastore:pkg-set-datetime!      vec val)(vector-set! vec 8 val))
(define-inline (datastore:pkg-set-storegrp!      vec val)(vector-set! vec 9 val))
(define-inline (datastore:pkg-set-datavol!       vec val)(vector-set! vec 10 val))
(define-inline (datastore:pkg-set-quality!       vec val)(vector-set! vec 11 val))
(define-inline (datastore:pkg-set-disk_id!       vec val)(vector-set! vec 12 val))
(define-inline (datastore:pkg-set-comment!       vec val)(vector-set! vec 13 val))

;;======================================================================
;; DB
;;======================================================================

(define (datashare:initialize-db db)
  (for-each
   (lambda (qry)
162
163
164
165
166
167
168











169
170
171
172
173
174
175
	 (res #f))
    (set! res (apply proc db params))
    (if (not idb)(sqlite3:finalize! dbstruct))
    ;; (print "open-run-close-no-exception-handling END" )
    res))

(define open-run-close open-run-close-no-exception-handling)












;;======================================================================
;; DATA IMPORT/EXPORT
;;======================================================================

(define (datashare:import-data source-path dest-path area version iteration)
  (let ((targ-path (conc dest-path "/" area "/" version "/" iteration)))







>
>
>
>
>
>
>
>
>
>
>







208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
	 (res #f))
    (set! res (apply proc db params))
    (if (not idb)(sqlite3:finalize! dbstruct))
    ;; (print "open-run-close-no-exception-handling END" )
    res))

(define open-run-close open-run-close-no-exception-handling)

(define (datashare:get-pkgs db area-filter version-filter iter-filter)
  (let ((res '()))
    (sqlite3:for-each-row ;; replace with fold ...
     (lambda (a . b)
       (set! res (cons (list->vector (cons a b)) res)))
     db 
     (conc "SELECT id,area,version_name,store_type,copied,source_path,iteration,submitter,datetime,storegrp,datavol,quality,disk_id,comment "
	   " FROM pkgs WHERE area like ? AND version_name LIKE ? AND iteration " iter-filter ";")
     area-filter version-filter)
    (reverse res)))

;;======================================================================
;; DATA IMPORT/EXPORT
;;======================================================================

(define (datashare:import-data source-path dest-path area version iteration)
  (let ((targ-path (conc dest-path "/" area "/" version "/" iteration)))
272
273
274
275
276
277
278



279
280
281





282







283











284





















285
286
287
288
289
290
291
     (iup:hbox (iup:label "Version:"     #:size label-size)   version-tb)
     ;; (iup:hbox (iup:label "Link only"    #:size label-size)   copy-link)
     ;; 	       (iup:label "Iteration:")   iteration)
     (iup:hbox (iup:label "Comment:"     #:size label-size)   comment-tb)
     (iup:hbox (iup:label "Source base path:" #:size label-size)   source-tb browse-btn)
     (iup:hbox copy link))))




(define (datashare:get-view configdat)
  (iup:vbox
   (iup:hbox 





    (iup:button "Pushme"







		#:expand "YES"











		))))






















(define (datashare:manage-view configdat)
  (iup:vbox
   (iup:hbox 
    (iup:button "Pushme"
		#:expand "YES"
		))))







>
>
>


|
>
>
>
>
>
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
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
     (iup:hbox (iup:label "Version:"     #:size label-size)   version-tb)
     ;; (iup:hbox (iup:label "Link only"    #:size label-size)   copy-link)
     ;; 	       (iup:label "Iteration:")   iteration)
     (iup:hbox (iup:label "Comment:"     #:size label-size)   comment-tb)
     (iup:hbox (iup:label "Source base path:" #:size label-size)   source-tb browse-btn)
     (iup:hbox copy link))))

(define (datastore:lst->path pathlst)
  (conc "/" (string-intersperse (map conc pathlst) "/")))

(define (datashare:get-view configdat)
  (iup:vbox
   (iup:hbox
    (let* ((label-size     "60x")
	   (area-filter    "%")
	   (version-filter "%")
	   (iter-filter    ">= 0")
	   (dat            (make-hash-table)) ;; reverse lookup
	   (apply          (iup:button "Apply"))
	   (source         (iup:textbox))
	   (submitter      (iup:label "" #:expand "HORIZONTAL"))
	   (date-submitted (iup:label "" #:expand "HORIZONTAL"))
	   (source-data    (iup:label "" #:expand "HORIZONTAL"))
	   (tb             (iup:treebox
			    #:value 0
			    #:name "Packages"
			    #:expand "YES"
			    #:addexpanded "NO"
			    #:selection-cb
			    (lambda (obj id state)
			      ;; (print "obj: " obj ", id: " id ", state: " state)
			      (let* ((path   (datastore:lst->path (cdr (tree:node->path obj id))))
				     (record (hash-table-ref/default dat path #f)))
				(if record
				    (begin
				      (iup:attribute-set! submitter "TITLE" (datastore:pkg-get-submitter record))
				      (iup:attribute-set! date-submitted "TITLE" (time->string (seconds->local-time (datastore:pkg-get-datetime record))))))
				(print  "id=" id " path=" path " record=" record);; (tree:node->path obj id) " run-id: " run-id)
				))))
	   (refresh        (lambda (obj)
			     (let ((db (datashare:open-db configdat)))
			       (for-each
				(lambda (pkgitem)
				  (let* ((pkg-path   (list (datastore:pkg-get-area  pkgitem)
							   (datastore:pkg-get-version_name pkgitem)
							   (datastore:pkg-get-iteration pkgitem)))
					 (pkg-id     (datastore:pkg-get-id          pkgitem))
					 (path       (datastore:lst->path pkg-path)))
				    ;; (print "tree:add-node tb=" tb ", pkg-path=" pkg-path ", pkg-id=" pkg-id)
				    (if (not (hash-table-ref/default dat path #f))
					(tree:add-node tb "Packages" pkg-path userdata: (conc "pkg-id: " pkg-id)))
				    ;; (print "path=" path " pkgitem=" pkgitem)
				    (hash-table-set! dat path pkgitem)))
				(datashare:get-pkgs db area-filter version-filter iter-filter))
			       (sqlite3:finalize! db)))))
      (iup:vbox 
       tb 
       (iup:hbox (iup:button "Refresh" #:action refresh) apply)
       (iup:hbox (iup:label "Submitter:" #:size label-size)(iup:hbox submitter)(iup:label "Date submitted:" #:size label-size))
       )))))

(define (datashare:manage-view configdat)
  (iup:vbox
   (iup:hbox 
    (iup:button "Pushme"
		#:expand "YES"
		))))