| ︙ | | | ︙ | |
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"
))))
|
| ︙ | | | ︙ | |