Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -177,7 +177,9 @@ 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 - BASEPATH=/tmp/$(USER)/basepath ./datashare-testing/datashare + +xterm : datashare + (export BASEPATH=/tmp/$(USER)/basepath ; export PATH="$(PWD)/datashare-testing:$(PATH)" ; xterm &) Index: datashare.scm ================================================================== --- datashare.scm +++ datashare.scm @@ -51,12 +51,12 @@ (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 version : Publish data to share, use group to protect - get version [destpath] : Get a link to data, put the link in destpath (i) + publish : Publish data to share, use group to protect + get : Get a link to data, put the link in destpath (i) update : 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 @@ -287,10 +287,28 @@ (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) @@ -382,30 +400,12 @@ (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) - ;; (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: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)))) + (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" @@ -624,10 +624,23 @@ (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))) @@ -646,9 +659,9 @@ (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)