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
.gitignore
+1
View File
@@ -20,3 +20,4 @@ compiled/
scribblings/*.html
scribblings/*.css
scribblings/*.js
scribblings/*.bak
audio-manager.rkt
+43 -11
View File
@@ -9,12 +9,15 @@
(require "private/flac-handling.rkt")
(require "private/opus-handling.rkt")
(require "private/log.rkt")
(require "private/store.rkt")
(require racket-audio)
(require simple-log)
(require simple-ini)
(provide audio-manager)
(store-config! #:kind 'keystore)
(define (audio-manager music-path opus-path #:log-level [log-level 'debug])
(let* ((ini-config-file (build-path music-path ".audio-manager.ini"))
(ini (file->ini ini-config-file))
@@ -23,10 +26,12 @@
(report-flac "")
(report-opus "")
(file-db-path (build-path music-path ".audio-manager.db"))
(file-db-hash (if (file-exists? file-db-path)
(deserialize (file->value file-db-path))
(make-hash)
))
(file-db-store (begin
(store-config! #:kind (ini-get ini
'manager
'storage-kind
'keystore))
(store-open file-db-path)))
(processed-dirs 0)
(processed-files 0)
(processed-opus 0)
@@ -39,6 +44,7 @@
(copied-files 0)
(failed-converts 0)
(failed-copies 0)
(not-in-source 0)
(processed-kind (make-hash))
(base-rate (ini-get ini 'flac 'max-khz 48000))
(dirs-logged -1)
@@ -161,8 +167,7 @@
(hash-set! info 'bits bits)
)
)
(values base-path path info)
)
(values base-path path info))
(define (flac-convert base-path path info)
(when (and (needs-processing? path info) (flac? path info))
@@ -238,7 +243,7 @@
(if (convert-to-opus path opus-file ini)
(begin
(set! converted-files (+ converted-files 1))
(info-am " Converted")
(info-am " Converted ~a" converted-files)
)
(begin
(info-am " CONVERSION PROBLEM")
@@ -281,13 +286,25 @@
path-part))))
(delete-directory/files rm-path #:must-exist? #f)
(let ((normalized-sub-path (hash-ref info 'path)))
(hash-remove! file-db-hash normalized-sub-path))
(store-remove! file-db-store normalized-sub-path))
)
)
)
)
(values base-path path info))
(define (updater base-path path info)
(when (not (eq? (hash-ref info 'file-db #f) 'deleted))
(let ((normalized-sub-path (hash-ref info 'path)))
(store-set! file-db-store normalized-sub-path info)))
(values base-path path info))
(define (target-tree-cleaner base-path path info)
(let ((normalized-sub-path (hash-ref info 'path)))
(unless (store-exists? file-db-store normalized-sub-path)
(set! not-in-source (+ not-in-source 1))))
(values base-path path info))
(define (log-processed-file base-path path info)
(dbg-am "processing ~a" path)
(if (eq? (hash-ref info 'type) 'dir)
@@ -358,6 +375,7 @@
(format "Copied files : ~a" copied-files)
(format "Failed convert : ~a" failed-converts)
(format "Failed copies : ~a" failed-copies)
(format "Not in source : ~a" not-in-source)
))
(subj (format "Audio manager report d.d. ~a" (date->yyyy-mm-dd (now))))
)
@@ -367,11 +385,12 @@
)
)
(sl-log-to-file&display (build-path music-path ".audio-manager.log"))
(info-am "Setting log level to ~a" log-level)
(sl-set-log-level log-level)
(let ((fw (make-file-admin music-path file-db-hash)))
(let ((fw (make-file-admin music-path file-db-store)))
;; Enrichment phase
(set! fw (fw-add-step fw adjust-ext))
(set! fw (fw-add-step fw flac-with-id3))
@@ -381,16 +400,29 @@
(set! fw (fw-add-step fw flac-picture))
(set! fw (fw-add-step fw to-opus))
(set! fw (fw-add-step fw copy-other))
;; Cleanup/Logging phase
;; Cleanup/Logging phase/updating
(set! fw (fw-add-step fw deleter))
(set! fw (fw-add-step fw log-processed-file))
(set! fw (fw-add-step fw updater))
(let loop ()
(let-values (((base-path path info) (fw)))
(if (eq? info #f)
(begin
(info-am "Finished walking music library")
(write-to-file (serialize file-db-hash) file-db-path #:exists 'replace)
;; Cleanup files in target, not in source
(info-am "Checking files in target, not in source")
(let ((fwt (make-file-walker opus-path "*" target-tree-cleaner)))
(let loop1 ()
(let-values (((base-path path info) (fwt)))
(if (eq? info #f)
(info-am "Target check finished")
(loop1)))))
(info-am "Closing store")
(store-close file-db-store)
(info-am "Reporting")
(report)
(info-am "Done")
'done)
(loop))))
)
private/file-walker.rkt
+51 -11
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
(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)
(hash-remove! db-hash key)
(hash-set! value 'file-db 'unknown)))))
(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)))
(let ((count (store-count db-store))
(k 0))
(let ((keys (store-keys db-store)))
(map (λ (key)
(let ((info (hash-ref db-hash key)))
(let ((info (store-ref db-store key)))
(hash-set! info 'file-db 'deleted)
info))
(filter (λ (key)
(let ((v (hash-ref db-hash 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)