hans/audio-library-manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

administration

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-29 10:42:56 +02:00
parent e538e8b180
commit 1caad21d73
5 changed files with 235 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/file-walker.rkt
+59 -19
View File
@@ -4,6 +4,8 @@
racket/generator
racket/string
racket/path
"store.rkt"
"log.rkt"
file/glob)
(provide make-file-walker
@@ -64,7 +66,7 @@
)
)
(define (make-file-admin base-path db-hash)
(define (make-file-admin base-path db-store)
(define (file-info-equal? i1 i2)
(if (eq? (hash-ref i1 'type) (hash-ref i2 'type))
@@ -79,12 +81,12 @@
(define (file-admin base-path path info)
(let* ((normalized-sub-path (hash-ref info 'path))
(in-db (hash-ref db-hash normalized-sub-path #f))
(in-db (store-ref db-store normalized-sub-path #f))
)
(cond
((eq? in-db #f)
(hash-set! info 'file-db 'new)
(hash-set! db-hash normalized-sub-path info)
(store-set! db-store normalized-sub-path info)
(values base-path path info)
)
(else
@@ -96,31 +98,69 @@
(when (eq? (hash-ref info 'type #f) 'file)
(hash-set! in-db 'size (hash-ref info 'size))
(hash-set! in-db 'mtime (hash-ref info 'mtime)))))
(hash-set! db-hash normalized-sub-path in-db)
(store-set! db-store normalized-sub-path in-db)
(values base-path path in-db)
)
)
))
(define (init-db-sweep)
(hash-for-each db-hash
(λ (key value)
(if (eq? (hash-ref value 'file-db #f) 'deleted)
(hash-remove! db-hash key)
(hash-set! value 'file-db 'unknown)))))
(store-transaction db-store
(let ((count (store-count db-store))
(k 0)
(last-perc 0))
(store-for-each db-store
(λ (key value)
(set! k (+ k 1))
(let ((perc (quotient (* k 100) count)))
(when (and (= (remainder perc 10) 0) (> perc last-perc))
(set! last-perc perc)
(info-am "init-db-sweep: ~a%, k=~a" perc k)))
(if (eq? (hash-ref value 'file-db #f) 'deleted)
(store-remove! db-store key)
(begin
(hash-set! value 'file-db 'unknown)
(store-set! db-store key value))
)
)
)
)
)
)
(define (get-deleted)
(let ((keys (hash-keys db-hash)))
(map (λ (key)
(let ((info (hash-ref db-hash key)))
(hash-set! info 'file-db 'deleted)
info))
(filter (λ (key)
(let ((v (hash-ref db-hash key)))
(eq? (hash-ref v 'file-db) 'unknown)))
keys))))
(let ((count (store-count db-store))
(k 0))
(let ((keys (store-keys db-store)))
(map (λ (key)
(let ((info (store-ref db-store key)))
(hash-set! info 'file-db 'deleted)
info))
(filter (λ (key)
(set! k (+ k 1))
(let ((perc (quotient (* k 100) count)))
(when (= (remainder perc 10) 0)
(info-am "get-deleteed: ~a%" perc)))
(let ((v (store-ref db-store key)))
(eq? (hash-ref v 'file-db) 'unknown)))
keys))))
)
(let* ((fw (make-file-walker base-path "*" file-admin))
(let* ((walker-count 0)
(fw (make-file-walker base-path "*"
(λ (base-path path info)
(cond
((= walker-count 0)
(store-begin db-store))
((= (remainder walker-count 250) 0)
(store-commit db-store)
(store-begin db-store))
)
(set! walker-count (+ walker-count 1))
(let-values (((base-path* path* info*) (file-admin base-path path info)))
(when (eq? info* #f)
(store-commit db-store))
(values base-path* path* info*)))))
(deleted #f))
(init-db-sweep)
(letrec ((f (λ ()
private/mail.rkt
+1 -1
View File
@@ -32,7 +32,7 @@
(if (list? report) report (list report))
#:port-no port
#:auth-user user
#:auth-pwd passwd
#:auth-passwd passwd
)
)
)
private/store.rkt
+131
View File
@@ -0,0 +1,131 @@
#lang racket
(require keystore
racket/serialize)
(provide store-ref
store-set!
store-open
store-close
store-new
store-config!
store-exists?
store-remove!
store-keys
store-for-each
store-count
store-transaction
store-begin
store-commit
)
(define store-kind 'hash)
(define (store-config! #:kind [kind 'hash])
(if (not (or (eq? kind 'hash) (eq? kind 'keystore)))
(error "kind needs to be 'hash or 'keystore")
(set! store-kind kind)))
(define (store-new file)
(if (eq? store-kind 'hash)
(let ((h (make-hash)))
(hash-set! h 'store-file file)
(list 'hash h))
(store-open file))
)
(define (store-open file)
(if (eq? store-kind 'hash)
(if (file-exists? file)
(deserialize (file->value file))
(store-new file))
(list 'keystore (ks-open file))))
(define (store-close st)
(if (eq? (car st) 'hash)
(let ((file (hash-ref (cadr st) 'store-file)))
(write-to-file
(serialize st) file #:exists 'replace))
(ks-close (cadr st))))
(define (store-ref st key . val)
(if (eq? (car st) 'hash)
(if (null? val)
(hash-ref (cadr st) key)
(hash-ref (cadr st) key (car val)))
(let ((v (if (null? val)
(ks-get (cadr st) key)
(ks-get (cadr st) key (car val)))))
(if (eq? v 'ks-nil)
(error "No such key in storage")
v))
)
)
(define (store-set! st key val)
(if (eq? (car st) 'hash)
(hash-set! (cadr st) key val)
(ks-set! (cadr st) key val)))
(define (store-remove! st key)
(if (eq? (car st) 'hash)
(hash-remove! (cadr st) key)
(ks-drop! (cadr st) key)))
(define (store-exists? st key)
(if (eq? (car st) 'hash)
(hash-has-key? (cadr st) key)
(ks-exists? (cadr st) key)))
(define (store-keys st)
(if (eq? (car st) 'hash)
(filter (λ (k)
(not (eq? k 'store-file)))
(hash-keys (cadr st)))
(ks-keys (cadr st))))
(define (store-count st)
(if (eq? (car st) 'hash)
(hash-count (cadr st))
(ks-key-count (cadr st))))
(define (store-for-each st f)
(if (eq? (car st) 'hash)
(hash-for-each (cadr st)
(λ (k v)
(unless (eq? k 'store-file)
(f k v))))
(let* ((ks (cadr st))
(keys (ks-keys ks)))
(for-each (λ (k)
(let ((v (ks-get ks k)))
(f k v)))
keys))
)
)
(define-syntax store-transaction
(syntax-rules ()
((_ st b1 ...)
(if (eq? (car st) 'hash)
(begin b1 ...)
(ks-transaction (cadr st) b1 ...)))))
(define (store-begin st)
(when (eq? (car st) 'keystore)
(ks-begin-transaction (cadr st)))
#t)
(define (store-commit st)
(when (eq? (car st) 'keystore)
(ks-end-transaction (cadr st)))
#t)