Megatest

Check-in [9f5bfafa07]
Login
Overview
Comment:First pass at publish via command line
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 9f5bfafa0793c28d042ed068055812fca8bffc32
User & Date: mrwellan on 2014-09-16 18:09:48
Other Links: branch diff | manifest | tags
Context
2014-09-16
23:17
datashare list-areas, list-versions working, publish partially working check-in: 0805063fb3 user: matt tags: v1.60
18:09
First pass at publish via command line check-in: 9f5bfafa07 user: mrwellan tags: v1.60
2014-09-15
22:42
Switch out loadrunner for nbfake, update help in datashare check-in: 6fc75e1afb user: mrwellan tags: v1.60
Changes

Modified Makefile from [3cfa0eb4e3] to [59b885c27c].

175
176
177
178
179
180
181


182

183
175
176
177
178
179
180
181
182
183

184
185







+
+
-
+

# 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
	mkdir -p /tmp/$(USER)/datashare/disk1 /tmp/$(USER)/basepath

xterm : datashare
	BASEPATH=/tmp/$(USER)/basepath ./datashare-testing/datashare
	(export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)

Modified datashare.scm from [9ed3a1c316] to [187c333057].

49
50
51
52
53
54
55
56
57


58
59
60
61
62
63
64
49
50
51
52
53
54
55


56
57
58
59
60
61
62
63
64







-
-
+
+







;; GLOBALS
;;
(define *datashare:current-tab-number* 0)
(define datashare:help (conc "Usage: datashare [action [params ...]]

Note: run datashare without parameters to start the gui.

  publish path <area> version         : Publish data to share, use group to protect
  get <area> version [destpath]       : Get a link to data, put the link in destpath (i)
  publish <path> <area> <version>     : Publish data to share, use group to protect
  get <area> <version>                : Get a link to data, put the link in destpath (i)
  update <area>                       : Update the link to data to the latest iteration.

(i) 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)) ;; "
285
286
287
288
289
290
291


















292
293
294
295
296
297
298
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    (thread-start! th1))
	  #t)
	(begin
	  (print "ERROR: Not enough space in storage area " dest-path)
	  (datashare:set-copied db id "no")
	  (sqlite3:finalize! db)
	  #f))))

(define (datashare:publish area-name version comment spath submitter quality)
  (let ((db          (datashare:open-db configdat))
	(iteration   (datashare:register-data db area-name version publish-type submitter quality spath comment))
	(dest-store  (datashare:get-best-storage configdat)))
    (if iteration
	(if (eq? 'copy publish-type)
	    (begin
	      (datashare:import-data configdat spath dest-store area-name version iteration)
	      (let ((id (datashare:get-id db area-name version iteration)))
		(datashare:set-latest db id area-name version iteration)))
	    (let ((id (datashare:get-id db area-name version iteration)))
	      (datashare:set-stored-path db id spath)
	      (datashare:set-copied db id "yes")
	      (datashare:set-copied db id "n/a")
	      (datashare:set-latest db id area-name version iteration)))
	(print "ERROR: Failed to get an iteration number"))
    (sqlite3:finalize! db)))

(define (datashare:get-best-storage configdat)
  (let* ((storage     (configf:lookup configdat "settings" "storage"))
	 (store-areas (if storage (string-split storage) '())))
    (print "Looking for available space in " store-areas)
    (datashare:find-most-space store-areas)))

380
381
382
383
384
385
386
387

388
389
390
391
392
393
394
395
396
397
398

399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
398
399
400
401
402
403
404

405











406








407
408
409
410
411
412
413







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







			       (area-dat    (if (> area-num 0)(list-ref areas (- area-num 1))'("NOT SELECTED" "NOT SELECTED")))
			       (area-path   (cadr area-dat))
			       (area-name   (car  area-dat))
			       (version     (iup:attribute version-tb "VALUE"))
			       (comment     (iup:attribute comment-tb "VALUE"))
			       (spath       (iup:attribute source-tb  "VALUE"))
			       (submitter   (current-user-name))
			       (quality     2)
			       (quality     2))
			       ;; (import-type (if (equal? (iup:attribute copy-link "VALUE") "ON" )
			       ;;  		'copy
			       ;;  		'link))
			       (db          (datashare:open-db configdat))
			       (iteration   (datashare:register-data db area-name version publish-type submitter quality spath comment))
			       (dest-store  (datashare:get-best-storage configdat)))
			  (if iteration
			      (if (eq? 'copy publish-type)
				  (begin
				    (datashare:import-data configdat spath dest-store area-name version iteration)
				    (let ((id (datashare:get-id db area-name version iteration)))
			  (datashare:publish area-name version comment spath submitter quality))))
				      (datashare:set-latest db id area-name version iteration)))
				  (let ((id (datashare:get-id db area-name version iteration)))
				    (datashare:set-stored-path db id spath)
				    (datashare:set-copied db id "yes")
				    (datashare:set-copied db id "n/a")
				    (datashare:set-latest db id area-name version iteration)))
			      (print "ERROR: Failed to get an iteration number"))
			  (sqlite3:finalize! db))))
	 (copy        (iup:button "Copy and Publish"
				  #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (publish 'copy))))
	 (link        (iup:button "Link and Publish"
				  #:expand "HORIZONTAL"
				  #:action (lambda (obj)
622
623
624
625
626
627
628













629
630
631
632
633
634
635
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648







+
+
+
+
+
+
+
+
+
+
+
+
+







    (ini:property-separator-patt " *  *")
    (ini:property-separator #\space)
    (if (file-exists? fname)
	;; (ini:read-ini fname)
	(read-config fname #f #t)
	(make-hash-table))))

(define (datashare:process-action configdat action args)
  (case (string->symbol action)
    ((publish)
     (if (< (length args) 3)
	 (begin 
	   (print "ERROR: Missing arguments; " (string-intersperse args ", "))
	   (exit))
	 (let* ((srcpath  (list-ref args 0))
		(areaname (list-ref args 1))
		(version  (list-ref args 2))
		(remargs  (drop args 3)))
	   (datashare:import-data configdat srcpath dest-path area version iteration))))))

;; ease debugging by loading ~/.dashboardrc - remove from production!
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.datasharerc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define (main)
  (let* ((args      (argv))
644
645
646
647
648
649
650
651

652
653
654
657
658
659
660
661
662
663

664
665
666
667







-
+



      (case (string->symbol (car rema))
	((help -h -help --h --help)
	 (print datashare:help))
	(else
	 (print "ERROR: Unrecognised command. Try \"datashare help\""))))
     ((null? rema)(datashare:gui configdat))
     ((>= (length rema) 2)
      (apply process-action (car rema)(cdr rema)))
      (apply datashare:process-action configdat (car rema)(cdr rema)))
     (else (print "ERROR: Unrecognised command. Try \"datashare help\"")))))

(main)