Megatest

Diff
Login

Differences From Artifact [600b946e0a]:

To Artifact [f6eb31ba0d]:


253
254
255
256
257
258
259
260

261
262

263
264
265
266
267
268
269
253
254
255
256
257
258
259

260
261

262
263
264
265
266
267
268
269







-
+

-
+







	 (targ-path   (conc disk-path "/" area "/" version "/" iteration))
	 (id          (datastore:get-id db area version iteration))
	 (db          (datashare:open-db configdat)))
    (if (> space-avail 10000) ;; dumb heuristic
	(begin
	  (create-directory targ-path #t)
	  (datastore:set-stored-path db id targ-path)
	  (print "Running command: rsync -av " source-path " " targ-path)
	  (print "Running command: rsync -av " source-path "/ " targ-path "/")
	  (let ((th1 (make-thread (lambda ()
				    (let ((pid (process-run "rsync" (list "-av" source-path targ-path))))
				    (let ((pid (process-run "rsync" (list "-av" (conc source-path "/") (conc targ-path "/")))))
				      (process-wait pid)
				      (datastore:set-copied db id "yes")
				      (sqlite3:finalize! db)))
				   "Data copy")))
	    (thread-start! th1))
	  #t)
	(begin
338
339
340
341
342
343
344
345

346
347
348
349
350
351
352
338
339
340
341
342
343
344

345
346
347
348
349
350
351
352







-
+







		       ;;  					     ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current
		       ;;  					     ;; #:x 'mouse
		       ;;  					     ;; #:y 'mouse
		       ;;  )					     
		       ))))

(define (datashare:publish-view configdat)
  (pp (hash-table->alist configdat))
  ;; (pp (hash-table->alist configdat))
  (let* ((areas       (configf:get-section configdat "areas"))
	 (label-size  "70x")
	 (areas-sel   (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES"))
	 (version-tb  (iup:textbox #:expand "HORIZONTAL")) ;;  #:size "50x"))
	 (areas-sel   (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES"))
	 (component   (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES" ))
	 (version-val (iup:textbox #:expand "HORIZONTAL" #:size "50x"))
395
396
397
398
399
400
401
402

403
404
405
406
407
408
409
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409







-
+







				  #:action (lambda (obj)
					     (let* ((fd  (iup:file-dialog #:dialogtype "DIR"))
						    (top (iup:show fd #:modal? "YES")))
					       (iup:attribute-set! source-tb "VALUE"
								   (iup:attribute fd "VALUE"))
					       (iup:destroy! fd))))))
    (print "areas")
    (pp areas)
    ;; (pp areas)
    (fold (lambda (areadat num)
	    ;; (print "Adding num=" num ", areadat=" areadat)
	    (iup:attribute-set! areas-sel (conc num) (car areadat))
	    (+ 1 num))
	  1 areas)
    (iup:vbox
     (iup:hbox (iup:label "Area:"        #:size label-size)   areas-sel)
463
464
465
466
467
468
469
470

471
472
473
474
475
476
477
463
464
465
466
467
468
469

470
471
472
473
474
475
476
477







-
+







				      (set! curr-record record)
				      (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))))
				      (iup:attribute-set! comment        "TITLE" (datastore:pkg-get-comment record))
				      (iup:attribute-set! quality        "TITLE" (datastore:pkg-get-quality record))
				      (iup:attribute-set! copy-link      "TITLE" (datastore:pkg-get-store_type record))
				      ))
				(print  "id=" id " path=" path " record=" record);; (tree:node->path obj id) " run-id: " run-id)
				;; (print  "id=" id " path=" path " record=" record);; (tree:node->path obj id) " run-id: " run-id)
				))))
	   (tb2             (iup:treebox
			    #:value 0
			    #:name "Installed"
			    #:expand "YES"
			    #:addexpanded "NO"
			    #:selection-cb
571
572
573
574
575
576
577















578
579
580
581
582
583

584
585

586
587
588
589
590
591
592





593
594
595
596



597

598
599
600
601
602
603
604
605
606
607
608
609
610
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597

598


599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618

619
620
621
622
623
624
625
626
627
628
629
630
631
632







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





-
+
-
-
+







+
+
+
+
+




+
+
+
-
+













	;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
	(iup:attribute-set! tabs "TABTITLE0" "Publish")
	(iup:attribute-set! tabs "TABTITLE1" "Get")
	(iup:attribute-set! tabs "TABTITLE2" "Manage")
	;; (iup:attribute-set! tabs "BGCOLOR" "190 190 190")
	tabs)))
  (iup:main-loop))

;;======================================================================
;; MISC
;;======================================================================

(define (datastore:find name paths)
  (if (null? paths)
      #f
      (let loop ((hed (car paths))
		 (tal (cdr paths)))
	(if (file-exists? (conc hed "/" name))
	    hed
	    (if (null? tal)
		#f
		(loop (car tal)(cdr tal)))))))

;;======================================================================
;; MAIN
;;======================================================================

(define (datashare:load-config path)
(define (datashare:load-config exe-dir exe-name)
  (let* ((exename (pathname-file (car (argv))))
	 (fname   (conc path "/." exename ".config")))
  (let* ((fname   (conc exe-dir "/." exe-name ".config")))
    (ini:property-separator-patt " *  *")
    (ini:property-separator #\space)
    (if (file-exists? fname)
	;; (ini:read-ini fname)
	(read-config fname #f #t)
	(make-hash-table))))

;; 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))
	 (prog      (car args))
	 (rema      (cdr args))
	 (exe-name  (pathname-file (car (argv))))
	 (exe-dir   (or (pathname-directory prog)
			(datastore:find exe-name (string-split (get-environment-variable "PATH") ":"))))
	 (configdat (datashare:load-config (pathname-directory prog))))
	 (configdat (datashare:load-config exe-dir exe-name)))
    (cond
     ((eq? (length rema) 1)
      (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)))
     (else (print "ERROR: Unrecognised command. Try \"datashare help\"")))))

(main)