Overview
| Comment: | More of datashare working |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
8d86e61bbb3fe0c6011bd508bb3001b3 |
| User & Date: | mrwellan on 2014-08-22 16:53:20 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-08-23
| ||
| 13:58 | Basics of get data in place check-in: 5cdc4cd6d0 user: matt tags: v1.60 | |
|
2014-08-22
| ||
| 16:53 | More of datashare working check-in: 8d86e61bbb user: mrwellan tags: v1.60 | |
| 10:36 | Basic publish function in datashare done check-in: 9a4d32c70f user: mrwellan tags: v1.60 | |
Changes
Modified Makefile from [5f716d848b] to [f67108acbc].
| ︙ | ︙ | |||
163 164 165 166 167 168 169 | csc -deploy $(CSCOPTS) $(OFILES) megatest.scm -o deploytarg mv deploytarg/deploytarg deploytarg/mtest deploytarg/dboard : $(OFILES) $(GOFILES) dashboard.scm deploytarg/apropos.so csc -deploy $(OFILES) $(GOFILES) dashboard.scm -o deploytarg mv deploytarg/deploytarg deploytarg/dboard | | > | | | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 | csc -deploy $(CSCOPTS) $(OFILES) megatest.scm -o deploytarg mv deploytarg/deploytarg deploytarg/mtest deploytarg/dboard : $(OFILES) $(GOFILES) dashboard.scm deploytarg/apropos.so csc -deploy $(OFILES) $(GOFILES) dashboard.scm -o deploytarg mv deploytarg/deploytarg deploytarg/dboard # DATASHAREO=configf.o common.o process.o tree.o dcommon.o margs.o launch.o gutils.o db.o synchash.o server.o \ # megatest-version.o tdb.o ods.o mt.o keys.o datashare-testing/datashare : datashare.scm $(OFILES) csc datashare.scm $(OFILES) -o datashare-testing/datashare datashare : datashare-testing/datashare ./datashare-testing/datashare |
Modified datashare.scm from [54278f4e4b] to [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 |
(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
| > > > | > > > > > | > > > > > > > | > > > > > > > > > > > | > > > > > > > > > > > > > > > > > > > > > | 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"
))))
|
| ︙ | ︙ |
Modified tree.scm from [e7e38b65a4] to [41e907e532].
| ︙ | ︙ | |||
63 64 65 66 67 68 69 | (if (> depth node-depth) ;; (+ 1 node-depth)) #f (loop hed tal depth (+ nodenum 1))))) #f)))) ;; top is the top node name zeroeth node VALUE=0 (define (tree:add-node obj top nodelst #!key (userdata #f)) | > | | | 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
(if (> depth node-depth) ;; (+ 1 node-depth))
#f
(loop hed tal depth (+ nodenum 1)))))
#f))))
;; top is the top node name zeroeth node VALUE=0
(define (tree:add-node obj top nodelst #!key (userdata #f))
(if (or (not (string? (iup:attribute obj "TITLE0")))
(string-null? (iup:attribute obj "TITLE0")))
(iup:attribute-set! obj "ADDBRANCH0" top))
(cond
((not (equal? top (iup:attribute obj "TITLE0")))
(print "ERROR: top name " top " doesn't match " (iup:attribute obj "TITLE0")))
((null? nodelst))
(else
(let loop ((hed (car nodelst))
(tal (cdr nodelst))
(depth 1)
(pathl (list top)))
|
| ︙ | ︙ |