Megatest

# 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
	(export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &)

;; 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>                : 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)) ;; "

	    (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)))

			       (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))










			  (datashare:publish area-name version comment spath submitter quality))))








	 (copy        (iup:button "Copy and Publish"
				  #:expand "HORIZONTAL"
				  #:action (lambda (obj)
					     (publish 'copy))))
	 (link        (iup:button "Link and Publish"
				  #:expand "HORIZONTAL"
				  #:action (lambda (obj)

    (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))

      (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 datashare:process-action configdat (car rema)(cdr rema)))
     (else (print "ERROR: Unrecognised command. Try \"datashare help\"")))))

(main)