| ︙ | | |
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
-
+
|
(define (datashare:open-db configdat)
(let ((path (configf:lookup configdat "database" "location")))
(if (and path
(directory? path)
(file-read-access? path))
(let* ((dbpath (conc path "/datashare.db"))
(writeable (file-write-access? dbpath))
(dbexists (file-exists? dbpath))
(dbexists (common:file-exists? dbpath))
(handler (make-busy-timeout 136000)))
(handle-exceptions
exn
(begin
(debug:print 2 *default-log-port* "ERROR: problem accessing db " dbpath
((condition-property-accessor 'exn 'message) exn))
(exit))
|
| ︙ | | |
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
|
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
|
-
+
|
res)))
(cons 0 #f)
paths))
;; remove existing link and if possible ...
;; create path to next of tip of target, create link back to source
(define (datashare:build-dir-make-link source target)
(if (file-exists? target)(datashare:backup-move target))
(if (common:file-exists? target)(datashare:backup-move target))
(create-directory (pathname-directory target) #t)
(create-symbolic-link source target))
(define (datashare:backup-move path)
(let* ((trashdir (conc (pathname-directory path) "/.trash"))
(trashfile (conc trashdir "/" (current-seconds) "-" (pathname-file path))))
(create-directory trashdir #t)
|
| ︙ | | |
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
|
-
+
|
(conc "/" (string-intersperse (map conc pathlst) "/")))
(define (datashare:path->lst path)
(string-split path "/"))
(define (datashare:pathdat-apply-heuristics configdat path)
(cond
((file-exists? path) "found")
((common:file-exists? path) "found")
(else (conc path " not installed"))))
(define (datashare:get-view configdat)
(iup:vbox
(iup:hbox
(let* ((label-size "60x")
;; filter elements
|
| ︙ | | |
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
|
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
|
-
+
-
+
|
(set! (current-effective-user-id) eid))))
(define (datashare:find name paths)
(if (null? paths)
#f
(let loop ((hed (car paths))
(tal (cdr paths)))
(if (file-exists? (conc hed "/" name))
(if (common:file-exists? (conc hed "/" name))
hed
(if (null? tal)
#f
(loop (car tal)(cdr tal)))))))
;;======================================================================
;; MAIN
;;======================================================================
(define (datashare:load-config exe-dir exe-name)
(let* ((fname (conc exe-dir "/." exe-name ".config")))
(ini:property-separator-patt " * *")
(ini:property-separator #\space)
(if (file-exists? fname)
(if (common: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)
((get)
|
| ︙ | | |
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
|
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
|
-
+
|
(conc "\"" (vector-ref x 4) "\""))
(print (vector-ref x 0))))
versions)
(sqlite3:finalize! db)))))
;; ease debugging by loading ~/.dashboardrc - REMOVE FROM PRODUCTION!
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.datasharerc")))
(if (file-exists? debugcontrolf)
(if (common:file-exists? debugcontrolf)
(load debugcontrolf)))
(define (main)
(let* ((args (argv))
(prog (car args))
(rema (cdr args))
(exe-name (pathname-file (car (argv))))
|
| ︙ | | |