Overview
| Comment: | Enough of datashare implemented to demo |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
c35d3e849380d2bdee40a60817048ccf |
| User & Date: | matt on 2014-08-24 18:19:34 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-08-24
| ||
| 20:53 | Fixed storage of links in datastore check-in: ff4b7bc45e user: matt tags: v1.60 | |
| 18:19 | Enough of datashare implemented to demo check-in: c35d3e8493 user: matt tags: v1.60 | |
| 17:08 | More datashare hacking done. check-in: 564660d855 user: matt tags: v1.60 | |
Changes
Modified datashare.scm from [38fe06106c] to [afd73c3669].
| ︙ | ︙ | |||
274 275 276 277 278 279 280 281 282 283 284 285 286 287 |
(define (datastore: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)
(datastore:find-most-space store-areas)))
(define (datastore:find-most-space paths)
(fold (lambda (area res)
;; (print "area=" area " res=" res)
(let ((maxspace (car res))
(currpath (cdr res)))
;; (print currpath " " maxspace)
(if (file-write-access? area)
| > > | > > | > | > > > > > > > > > > > > > > > > > | 274 275 276 277 278 279 280 281 282 283 284 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 317 318 319 320 321 322 323 324 325 |
(define (datastore: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)
(datastore:find-most-space store-areas)))
;; (string->number (list-ref (with-input-from-pipe "df -B1000000 /tmp" (lambda ()(read-line)(string-split (read-line)))) 3))
(define (datastore:find-most-space paths)
(fold (lambda (area res)
;; (print "area=" area " res=" res)
(let ((maxspace (car res))
(currpath (cdr res)))
;; (print currpath " " maxspace)
(if (file-write-access? area)
(let ((currspace (string->number
(list-ref
(with-input-from-pipe
;; (conc "df --output=avail " area)
(conc "df -B1000000 " area)
;; (lambda ()(read)(read))
(lambda ()(read-line)(string-split (read-line))))
3))))
(if (> currspace maxspace)
(cons currspace area)
res))
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 (datastore:build-dir-make-link source target)
(if (file-exists? target)(datastore:backup-move target))
(create-directory (pathname-directory target) #t)
(create-symbolic-link source target))
(define (datastore:backup-move path)
(let* ((trashdir (conc (pathname-directory path) "/.trash"))
(trashfile (conc trashdir "/" (current-seconds) "-" (pathname-file path))))
(create-directory trashdir #t)
(if (directory? path)
(system (conc "mv " path " " trashfile))
(file-move path trash-file))))
;;======================================================================
;; GUI
;;======================================================================
;; The main menu
(define (datashare:main-menu)
|
| ︙ | ︙ | |||
393 394 395 396 397 398 399 | (define (datastore:path->lst path) (string-split path "/")) (define (datastore:pathdat-apply-heuristics configdat path) (cond ((file-exists? path) "found") | | | 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 |
(define (datastore:path->lst path)
(string-split path "/"))
(define (datastore:pathdat-apply-heuristics configdat path)
(cond
((file-exists? path) "found")
(else (conc path " not installed"))))
(define (datashare:get-view configdat)
(iup:vbox
(iup:hbox
(let* ((label-size "60x")
;; filter elements
(area-filter "%")
|
| ︙ | ︙ | |||
479 480 481 482 483 484 485 | ;; (for-each (lambda (area) (let* ((path (conc "/" (cadr area))) (fullpath (conc basepath path))) (if (not (hash-table-ref/default installed-dat path #f)) (tree:add-node tb2 "Installed" (datastore:path->lst path))) | | > | | | > > > | | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 |
;;
(for-each
(lambda (area)
(let* ((path (conc "/" (cadr area)))
(fullpath (conc basepath path)))
(if (not (hash-table-ref/default installed-dat path #f))
(tree:add-node tb2 "Installed" (datastore:path->lst path)))
(hash-table-set! installed-dat path (datastore:pathdat-apply-heuristics configdat fullpath))))
areas)
(sqlite3:finalize! db))))
(apply (iup:button "Apply"
#:action
(lambda (obj)
(if curr-record
(let* ((area (datastore:pkg-get-area curr-record))
(stored-path (datastore:pkg-get-stored_path curr-record))
(source-type (datastore:pkg-get-store_type curr-record))
(source-path (case source-type ;; (equal? source-type "link"))
((link)(datastore:pkg-get-source-path curr-record))
((copy)stored-path)
(else #f)))
(dest-stub (configf:lookup configdat "areas" area))
(target-path (conc basepath "/" dest-stub)))
(datastore:build-dir-make-link stored-path target-path)
(print "Creating link from " stored-path " to " target-path)))))))
(iup:vbox
(iup:hbox tb tb2)
(iup:frame
#:title "Source Info"
(iup:vbox
(iup:hbox (iup:button "Refresh" #:action refresh) apply)
(iup:hbox (iup:label "Submitter: ") ;; #:size label-size)
|
| ︙ | ︙ |