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

string keys are stored as strings.

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-30 10:21:00 +02:00
parent 1caad21d73
commit ebf6b096da
3 changed files with 140 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files
audio-manager.rkt
+84 -21
View File
@@ -1,18 +1,19 @@
#lang racket/base #lang racket/base
(require racket/file) (require racket/file
(require racket/serialize) racket/serialize
(require racket/string) racket/port
(require "private/file-walker.rkt") racket/string
(require "private/util.rkt") "private/file-walker.rkt"
(require "private/mail.rkt") "private/util.rkt"
(require "private/flac-handling.rkt") "private/mail.rkt"
(require "private/opus-handling.rkt") "private/flac-handling.rkt"
(require "private/log.rkt") "private/opus-handling.rkt"
(require "private/store.rkt") "private/log.rkt"
(require racket-audio) "private/store.rkt"
(require simple-log) racket-audio
(require simple-ini) simple-log
simple-ini)
(provide audio-manager) (provide audio-manager)
@@ -44,7 +45,13 @@
(copied-files 0) (copied-files 0)
(failed-converts 0) (failed-converts 0)
(failed-copies 0) (failed-copies 0)
(files-in-target 0)
(dirs-in-target 0)
(last-dirs-in-target -1)
(not-in-source 0) (not-in-source 0)
(jobs 0)
(max-jobs (ini-get ini 'audio-manager 'max-jobs 6))
(job-nr 0)
(processed-kind (make-hash)) (processed-kind (make-hash))
(base-rate (ini-get ini 'flac 'max-khz 48000)) (base-rate (ini-get ini 'flac 'max-khz 48000))
(dirs-logged -1) (dirs-logged -1)
@@ -113,6 +120,10 @@
(eq? s 'flac)) (eq? s 'flac))
#f)) #f))
(define (opus? info)
(and (eq? (hash-ref info 'type) 'file)
(eq? (hash-ref info 'ext) 'opus)))
(define (rep-id3 path) (define (rep-id3 path)
(set! report-flacs-with-id3 (set! report-flacs-with-id3
(string-append report-flacs-with-id3 (string-append report-flacs-with-id3
@@ -222,6 +233,7 @@
) )
(values base-path path info)) (values base-path path info))
;; Converteer naar opus indien nodig en flac. ;; Converteer naar opus indien nodig en flac.
(define (to-opus base-path path info) (define (to-opus base-path path info)
(when (and (needs-processing? path info) (when (and (needs-processing? path info)
@@ -234,28 +246,49 @@
(set! processed-opus (+ processed-opus 1)) (set! processed-opus (+ processed-opus 1))
(info-am "Converting flac to opus: ~a" opus-file) (info-am "Converting flac to opus: ~a" opus-file)
(rep-opus (rep-opus
(format "Converting flac to opus: ~a" (basename opus-file))) (format "Converting flac to opus in thread: ~a" (basename opus-file)))
(let loop ()
(if (= jobs max-jobs)
(begin
(sleep 0.1)
(loop))
(begin
(set! job-nr (+ job-nr 1))
(set! jobs (+ jobs 1))
(let ((jobnr job-nr))
(thread
(λ ()
(with-handlers ([exn? (λ (e) (with-handlers ([exn? (λ (e)
(set! failed-converts (+ failed-converts 1)) (set! failed-converts (+ failed-converts 1))
(err-am "Conversion of ~a: ~a" path e))]) (err-am "Conversion of ~a: ~a" path e))])
(unless (directory-exists? (basedir opus-file)) (unless (directory-exists? (basedir opus-file))
(make-directory* (basedir opus-file))) (make-directory* (basedir opus-file)))
(info-am " Starting conversion job ~a" jobnr)
(if (convert-to-opus path opus-file ini) (if (convert-to-opus path opus-file ini)
(begin (begin
(set! converted-files (+ converted-files 1)) (set! converted-files (+ converted-files 1))
(info-am " Converted ~a" converted-files) (info-am " Converted ~a, job-nr = ~a" converted-files jobnr)
) )
(begin (begin
(info-am " CONVERSION PROBLEM") (info-am " CONVERSION PROBLEM, job-nr = ~a" jobnr)
(rep-opus " Conversion failed!") (rep-opus " Conversion failed!")
(set! failed-converts (+ failed-converts 1)) (set! failed-converts (+ failed-converts 1))
) )
) )
(set! jobs (- jobs 1))
)
)
#:pool 'own
) )
) )
) )
) )
) )
)
)
))
(values base-path path info)) (values base-path path info))
;; Kopieer bestanden rechtstreeks indien nodig en geen flac ;; Kopieer bestanden rechtstreeks indien nodig en geen flac
@@ -300,10 +333,27 @@
(values base-path path info)) (values base-path path info))
(define (target-tree-cleaner base-path path info) (define (target-tree-cleaner base-path path info)
(if (eq? (hash-ref info 'type #f) 'dir)
(set! dirs-in-target (+ dirs-in-target 1))
(set! files-in-target (+ files-in-target 1)))
(when (or (and
(= (remainder dirs-in-target 100) 0)
(> (quotient dirs-in-target 100) last-dirs-in-target))
(= (remainder files-in-target 1000) 0))
(set! last-dirs-in-target (quotient dirs-in-target 100))
(info-am "Files in target checked: ~a, dirs: ~a" files-in-target dirs-in-target)
(sync-log-am)
)
(let ((normalized-sub-path (hash-ref info 'path))) (let ((normalized-sub-path (hash-ref info 'path)))
(when (opus? info)
(set! normalized-sub-path (path-replace-extension normalized-sub-path #".flac")))
(unless (store-exists? file-db-store normalized-sub-path) (unless (store-exists? file-db-store normalized-sub-path)
(set! not-in-source (+ not-in-source 1)))) (info-am "Not in source: ~a" normalized-sub-path)
(values base-path path info)) (delete-directory/files path #:must-exist? #f)
(sync-log-am)
(set! not-in-source (+ not-in-source 1)))
(values base-path path info)))
(define (log-processed-file base-path path info) (define (log-processed-file base-path path info)
(dbg-am "processing ~a" path) (dbg-am "processing ~a" path)
@@ -323,8 +373,8 @@
(hash-set! processed-kind ext n))) (hash-set! processed-kind ext n)))
) )
(when (or (= (remainder processed-dirs 10) 0) (when (or (= (remainder processed-dirs 100) 0)
(= (remainder processed-files 250) 0)) (= (remainder processed-files 1000) 0))
(unless (= dirs-logged processed-dirs) (unless (= dirs-logged processed-dirs)
(set! dirs-logged processed-dirs) (set! dirs-logged processed-dirs)
(info-am (format "processed dirs: ~a, files: ~a, kinds: ~a, unknown kinds: ~a" (info-am (format "processed dirs: ~a, files: ~a, kinds: ~a, unknown kinds: ~a"
@@ -340,6 +390,7 @@
(map (λ (ext) (symbol->string ext)) unknown-exts) (map (λ (ext) (symbol->string ext)) unknown-exts)
", ") ", ")
)) ))
(sync-log-am)
)) ))
(when (flac-id3? info) (when (flac-id3? info)
@@ -375,6 +426,8 @@
(format "Copied files : ~a" copied-files) (format "Copied files : ~a" copied-files)
(format "Failed convert : ~a" failed-converts) (format "Failed convert : ~a" failed-converts)
(format "Failed copies : ~a" failed-copies) (format "Failed copies : ~a" failed-copies)
(format "Files in target: ~a" files-in-target)
(format "Dirs in target : ~a" dirs-in-target)
(format "Not in source : ~a" not-in-source) (format "Not in source : ~a" not-in-source)
)) ))
(subj (format "Audio manager report d.d. ~a" (date->yyyy-mm-dd (now)))) (subj (format "Audio manager report d.d. ~a" (date->yyyy-mm-dd (now))))
@@ -409,6 +462,14 @@
(let-values (((base-path path info) (fw))) (let-values (((base-path path info) (fw)))
(if (eq? info #f) (if (eq? info #f)
(begin (begin
; Wait for all conversions to finish
(let loop ()
(if (= jobs 0)
#t
(begin
(sleep 0.1)
(loop))))
; Process Rest.
(info-am "Finished walking music library") (info-am "Finished walking music library")
;; Cleanup files in target, not in source ;; Cleanup files in target, not in source
(info-am "Checking files in target, not in source") (info-am "Checking files in target, not in source")
@@ -416,7 +477,9 @@
(let loop1 () (let loop1 ()
(let-values (((base-path path info) (fwt))) (let-values (((base-path path info) (fwt)))
(if (eq? info #f) (if (eq? info #f)
(info-am "Target check finished") (begin
(info-am "Target check finished, not in source: ~a" not-in-source)
(info-am "Files in target checked: ~a" files-in-target))
(loop1))))) (loop1)))))
(info-am "Closing store") (info-am "Closing store")
(store-close file-db-store) (store-close file-db-store)
private/file-walker.rkt
+12 -4
View File
@@ -130,7 +130,8 @@
(define (get-deleted) (define (get-deleted)
(let ((count (store-count db-store)) (let ((count (store-count db-store))
(k 0)) (k 0)
(last-perc 0))
(let ((keys (store-keys db-store))) (let ((keys (store-keys db-store)))
(map (λ (key) (map (λ (key)
(let ((info (store-ref db-store key))) (let ((info (store-ref db-store key)))
@@ -139,7 +140,8 @@
(filter (λ (key) (filter (λ (key)
(set! k (+ k 1)) (set! k (+ k 1))
(let ((perc (quotient (* k 100) count))) (let ((perc (quotient (* k 100) count)))
(when (= (remainder perc 10) 0) (when (and (= (remainder perc 10) 0) (> perc last-perc))
(set! last-perc perc)
(info-am "get-deleteed: ~a%" perc))) (info-am "get-deleteed: ~a%" perc)))
(let ((v (store-ref db-store key))) (let ((v (store-ref db-store key)))
(eq? (hash-ref v 'file-db) 'unknown))) (eq? (hash-ref v 'file-db) 'unknown)))
@@ -147,14 +149,20 @@
) )
(let* ((walker-count 0) (let* ((walker-count 0)
(last-commit-s (current-seconds))
(fw (make-file-walker base-path "*" (fw (make-file-walker base-path "*"
(λ (base-path path info) (λ (base-path path info)
(let ((tm (current-seconds)))
(cond (cond
((= walker-count 0) ((= walker-count 0)
(store-begin db-store)) (store-begin db-store))
((= (remainder walker-count 250) 0) ((or (= (remainder walker-count 250) 0)
(> (- tm last-commit-s) 5))
(store-commit db-store) (store-commit db-store)
(store-begin db-store)) (store-begin db-store)
(set! last-commit-s tm)
)
)
) )
(set! walker-count (+ walker-count 1)) (set! walker-count (+ walker-count 1))
(let-values (((base-path* path* info*) (file-admin base-path path info))) (let-values (((base-path* path* info*) (file-admin base-path path info)))
private/store.rkt
+15 -8
View File
@@ -19,6 +19,9 @@
store-commit store-commit
) )
(define (cvtkey k)
(string-downcase (format "~a" k)))
(define store-kind 'hash) (define store-kind 'hash)
(define (store-config! #:kind [kind 'hash]) (define (store-config! #:kind [kind 'hash])
@@ -48,7 +51,8 @@
(serialize st) file #:exists 'replace)) (serialize st) file #:exists 'replace))
(ks-close (cadr st)))) (ks-close (cadr st))))
(define (store-ref st key . val) (define (store-ref st key* . val)
(let ((key (cvtkey key*)))
(if (eq? (car st) 'hash) (if (eq? (car st) 'hash)
(if (null? val) (if (null? val)
(hash-ref (cadr st) key) (hash-ref (cadr st) key)
@@ -60,22 +64,25 @@
(error "No such key in storage") (error "No such key in storage")
v)) v))
) )
) ))
(define (store-set! st key val) (define (store-set! st key* val)
(let ((key (cvtkey key*)))
(if (eq? (car st) 'hash) (if (eq? (car st) 'hash)
(hash-set! (cadr st) key val) (hash-set! (cadr st) key val)
(ks-set! (cadr st) key val))) (ks-set! (cadr st) key val))))
(define (store-remove! st key) (define (store-remove! st key*)
(let ((key (cvtkey key*)))
(if (eq? (car st) 'hash) (if (eq? (car st) 'hash)
(hash-remove! (cadr st) key) (hash-remove! (cadr st) key)
(ks-drop! (cadr st) key))) (ks-drop! (cadr st) key))))
(define (store-exists? st key) (define (store-exists? st key*)
(let ((key (cvtkey key*)))
(if (eq? (car st) 'hash) (if (eq? (car st) 'hash)
(hash-has-key? (cadr st) key) (hash-has-key? (cadr st) key)
(ks-exists? (cadr st) key))) (ks-exists? (cadr st) key))))
(define (store-keys st) (define (store-keys st)
(if (eq? (car st) 'hash) (if (eq? (car st) 'hash)