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

Initial import

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-08 17:20:12 +02:00
parent a3c561d2f2
commit 5e860a3d8b
16 changed files with 702 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/audio.rkt
+16
View File
@@ -0,0 +1,16 @@
#lang racket/base
(provide inspect-flac-sample-rate)
(define (inspect-flac-sample-rate path)
(define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
(define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
(define tags-sample-rate (dynamic-require 'racket-audio/taglib 'tags-sample-rate))
(define sr
(call-with-id3-tags path
(lambda (tags)
(and (tags-valid? tags) (tags-sample-rate tags)))
#:mode 'read))
(unless (and (integer? sr) (positive? sr))
(error 'inspect-flac-sample-rate "cannot determine sample rate for ~a" path))
sr)
private/config.rkt
+105
View File
@@ -0,0 +1,105 @@
#lang racket/base
(require racket/file
racket/path
simple-ini
"util.rkt")
(provide manager-config?
manager-config-base-dir
manager-config-ini-file
manager-config-state-file
manager-config-log-file
manager-config-max-sample-rate
manager-config-hash-algorithm
manager-config-dry-run?
manager-config-display-log?
manager-config-compression-level
manager-config-mail-enabled?
manager-config-mail-send-on-success?
manager-config-mail-send-on-error?
manager-config-mail-host
manager-config-mail-port
manager-config-mail-tls?
manager-config-mail-username
manager-config-mail-password
manager-config-mail-from
manager-config-mail-to
manager-config-mail-cc
manager-config-mail-bcc
manager-config-mail-subject-prefix
load-manager-config
ensure-default-config!)
(struct manager-config
(base-dir ini-file state-file log-file max-sample-rate hash-algorithm dry-run?
display-log? compression-level mail-enabled? mail-send-on-success?
mail-send-on-error? mail-host mail-port mail-tls? mail-username
mail-password mail-from mail-to mail-cc mail-bcc mail-subject-prefix)
#:transparent)
(define (default-log-file base-dir)
(build-path base-dir ".flac-48khz-manager.log"))
(define (default-ini base-dir)
(build-path base-dir ".flac-48khz-manager.ini"))
(define (default-state base-dir)
(build-path base-dir ".music-info.db"))
(define (ensure-default-config! ini-file)
(unless (file-exists? ini-file)
(define ini (make-ini))
(ini-set! ini 'manager 'max-sample-rate 48000)
(ini-set! ini 'manager 'hash-algorithm "sha256")
(ini-set! ini 'manager 'dry-run #f)
(ini-set! ini 'manager 'display-log #t)
(ini-set! ini 'manager 'log-file ".flac-48khz-manager.log")
(ini-set! ini 'manager 'compression-level 5)
(ini-set! ini 'mail 'enabled #f)
(ini-set! ini 'mail 'send-on-success #f)
(ini-set! ini 'mail 'send-on-error #t)
(ini-set! ini 'mail 'host "")
(ini-set! ini 'mail 'port 25)
(ini-set! ini 'mail 'tls #f)
(ini-set! ini 'mail 'username "")
(ini-set! ini 'mail 'password "")
(ini-set! ini 'mail 'from "")
(ini-set! ini 'mail 'to "")
(ini-set! ini 'mail 'cc "")
(ini-set! ini 'mail 'bcc "")
(ini-set! ini 'mail 'subject-prefix "[flac-48khz-manager]")
(ini->file ini ini-file)))
(define (resolve-log-file base-dir v)
(define p (string-value v ".flac-48khz-manager.log"))
(cond [(path-string? p)
(define bp (string->path p))
(if (absolute-path? bp) bp (build-path base-dir bp))]
[else (default-log-file base-dir)]))
(define (load-manager-config base-dir*)
(define base-dir (simple-form-path base-dir*))
(define ini-file (default-ini base-dir))
(ensure-default-config! ini-file)
(define ini (file->ini ini-file))
(define log-file (resolve-log-file base-dir (ini-get ini 'manager 'log-file ".flac-48khz-manager.log")))
(manager-config base-dir ini-file (default-state base-dir) log-file
(int-value (ini-get ini 'manager 'max-sample-rate 48000) 48000)
(string-downcase (string-value (ini-get ini 'manager 'hash-algorithm "sha256") "sha256"))
(bool-value (ini-get ini 'manager 'dry-run #f) #f)
(bool-value (ini-get ini 'manager 'display-log #t) #t)
(int-value (ini-get ini 'manager 'compression-level 5) 5)
(bool-value (ini-get ini 'mail 'enabled #f) #f)
(bool-value (ini-get ini 'mail 'send-on-success #f) #f)
(bool-value (ini-get ini 'mail 'send-on-error #t) #t)
(string-value (ini-get ini 'mail 'host "") "")
(int-value (ini-get ini 'mail 'port 25) 25)
(bool-value (ini-get ini 'mail 'tls #f) #f)
(string-value (ini-get ini 'mail 'username "") "")
(string-value (ini-get ini 'mail 'password "") "")
(string-value (ini-get ini 'mail 'from "") "")
(split-addresses (ini-get ini 'mail 'to ""))
(split-addresses (ini-get ini 'mail 'cc ""))
(split-addresses (ini-get ini 'mail 'bcc ""))
(string-value (ini-get ini 'mail 'subject-prefix "[flac-48khz-manager]") "[flac-48khz-manager]")))
private/convert-place.rkt
+46
View File
@@ -0,0 +1,46 @@
#lang racket/base
(require racket/file
racket/path
racket/place
"util.rkt")
(provide convert-flac-to-target-in-place)
(define (temp-output-path input-path)
(define-values (base name dir?) (split-path input-path))
(define name-str (path->string name))
(build-path base (format ".~a.tmp-~a.flac" name-str (current-inexact-milliseconds))))
(define (settings->alist max-sample-rate compression-level)
(list (cons 'target-sample-rate max-sample-rate)
(cons 'compression-level compression-level)))
(define (convert-flac-to-target-in-place input-path max-sample-rate compression-level)
(define tmp-path (temp-output-path input-path))
(define worker
(place ch
(define msg (place-channel-get ch))
(define in-file (list-ref msg 0))
(define out-file (list-ref msg 1))
(define settings (list-ref msg 2))
(with-handlers ([exn:fail?
(lambda (e)
(place-channel-put ch (list 'error (exn-message e))))])
(define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
(define result (audio-encode in-file out-file (make-immutable-hash settings)
#:encoder 'flac
#:copy-tags? #t))
(place-channel-put ch (list 'ok result)))))
(place-channel-put worker (list (path->string input-path)
(path->string tmp-path)
(settings->alist max-sample-rate compression-level)))
(define response (place-channel-get worker))
(cond [(and (pair? response) (eq? (car response) 'ok))
(rename-file-or-directory tmp-path input-path #t)
(cadr response)]
[else
(when (file-exists? tmp-path) (delete-file tmp-path))
(error 'convert-flac-to-target-in-place "conversion failed for ~a: ~a"
input-path
(if (and (pair? response) (pair? (cdr response))) (cadr response) response))]))
private/hash.rkt
+20
View File
@@ -0,0 +1,20 @@
#lang racket/base
(require openssl/sha1
openssl/md5)
(provide file-digest)
(define (digest->string v)
(cond [(bytes? v) (bytes->hex-string v)]
[(string? v) v]
[else (format "~a" v)]))
(define (file-digest path [algorithm "sha256"])
(define alg (string-downcase (format "~a" algorithm)))
(call-with-input-file path
(lambda (in)
(cond [(member alg '("sha256" "sha-256" "sha2")) (digest->string (sha256-bytes in))]
[(member alg '("md5")) (digest->string (md5 in))]
[else (error 'file-digest "unsupported digest algorithm: ~a" algorithm)]))
#:mode 'binary))
private/log.rkt
+22
View File
@@ -0,0 +1,22 @@
#lang racket/base
(require racket/file
simple-log)
(provide setup-logging!
dbg-alm
info-alm
warn-alm
err-alm
fatal-alm
sync-log-alm)
(sl-def-log audio-library-manager alm)
(define (setup-logging! log-file display-log?)
(make-directory* (let-values ([(base name dir?) (split-path log-file)]) base))
(if display-log?
(sl-log-to-file&display log-file)
(sl-log-to-file log-file))
(sl-set-log-level 'debug)
(info-alm "logging initialized: ~a" log-file))
private/mail.rkt
+33
View File
@@ -0,0 +1,33 @@
#lang racket/base
(require smtp
"config.rkt"
"report.rkt")
(provide maybe-send-report-mail)
(define (maybe-send-report-mail config summary errors)
(define has-errors? (positive? (summary-ref summary 'errors 0)))
(define should-send?
(and (manager-config-mail-enabled? config)
(not (null? (manager-config-mail-to config)))
(or (and has-errors? (manager-config-mail-send-on-error? config))
(and (not has-errors?) (manager-config-mail-send-on-success? config)))))
(when should-send?
(define subject (format "~a FLAC 48 kHz manager: ~a error(s), ~a converted"
(manager-config-mail-subject-prefix config)
(summary-ref summary 'errors 0)
(summary-ref summary 'converted 0)))
(define body (html-report subject summary errors))
(define mail (make-mail subject body
#:from (manager-config-mail-from config)
#:to (manager-config-mail-to config)
#:cc (manager-config-mail-cc config)
#:bcc (manager-config-mail-bcc config)
#:body-content-type "text/html"))
(send-smtp-mail mail
#:host (manager-config-mail-host config)
#:port (manager-config-mail-port config)
#:tls-encode (manager-config-mail-tls? config)
#:username (manager-config-mail-username config)
#:password (manager-config-mail-password config))))
private/report.rkt
+57
View File
@@ -0,0 +1,57 @@
#lang racket/base
(require racket/list
racket/string
"util.rkt")
(provide make-empty-summary
summary-inc
summary-set
summary-ref
summary->lines
html-report)
(define summary-keys '(seen processed new changed unchanged ok converted removed skipped errors dry-run))
(define (make-empty-summary)
(append (for/list ([k (in-list summary-keys)]) (cons k 0))
(list (cons 'error-list '()))))
(define (summary-ref summary key [default 0])
(alist-ref/default summary key default))
(define (summary-set summary key value)
(alist-set summary key value))
(define (summary-inc summary key [amount 1])
(summary-set summary key (+ (summary-ref summary key 0) amount)))
(define (summary->lines summary)
(for/list ([k (in-list summary-keys)])
(format "~a: ~a" k (summary-ref summary k 0))))
(define (html-escape s)
(define x (format "~a" s))
(define y (regexp-replace* #rx"&" x "&"))
(define z (regexp-replace* #rx"<" y "&lt;"))
(regexp-replace* #rx">" z "&gt;"))
(define (html-report title summary errors)
(define rows
(apply string-append
(for/list ([k (in-list summary-keys)])
(format "<tr><th style=\"text-align:left;padding:4px 10px 4px 0\">~a</th><td style=\"text-align:right;padding:4px\">~a</td></tr>"
(html-escape k) (summary-ref summary k 0)))))
(define error-html
(if (null? errors)
"<p>No errors were reported.</p>"
(string-append
"<h2>Errors</h2><table border=\"1\" cellspacing=\"0\" cellpadding=\"4\"><tr><th>File</th><th>Error</th></tr>"
(apply string-append
(for/list ([e (in-list errors)])
(format "<tr><td>~a</td><td><pre style=\"white-space:pre-wrap\">~a</pre></td></tr>"
(html-escape (alist-ref/default e 'file ""))
(html-escape (alist-ref/default e 'message "")))))
"</table>")))
(format "<!doctype html><html><head><meta charset=\"utf-8\"><title>~a</title></head><body><h1>~a</h1><h2>Summary</h2><table>~a</table>~a</body></html>"
(html-escape title) (html-escape title) rows error-html))
private/scan.rkt
+12
View File
@@ -0,0 +1,12 @@
#lang racket/base
(require racket/file
racket/list
"util.rkt")
(provide find-flac-files)
(define (find-flac-files base-dir)
(sort (find-files flac-path? base-dir)
string<?
#:key path->string))
private/state.rkt
+33
View File
@@ -0,0 +1,33 @@
#lang racket/base
(require racket/string
keystore)
(provide open-manager-state
file-state-key
state-get-file
state-set-file!
state-drop-file!
state-known-relpaths)
(define prefix "flac-48khz:file:")
(define (open-manager-state state-file)
(ks-open state-file))
(define (file-state-key relpath)
(string-append prefix relpath))
(define (state-get-file ks relpath [default #f])
(ks-get ks (file-state-key relpath) default))
(define (state-set-file! ks relpath value)
(ks-set! ks (file-state-key relpath) value))
(define (state-drop-file! ks relpath)
(ks-drop! ks (file-state-key relpath)))
(define (state-known-relpaths ks)
(map (lambda (k)
(substring k (string-length prefix)))
(ks-keys-glob ks (string-append prefix "*"))))
private/util.rkt
+65
View File
@@ -0,0 +1,65 @@
#lang racket/base
(require racket/file
racket/list
racket/path
racket/string)
(provide bool-value
int-value
string-value
split-addresses
relpath-string
flac-path?
ensure-parent-directory!
alist-ref/default
alist-set)
(define (bool-value v [default #f])
(cond [(boolean? v) v]
[(number? v) (not (zero? v))]
[(string? v)
(define s (string-downcase (string-trim v)))
(cond [(member s '("#t" "true" "yes" "y" "1" "on")) #t]
[(member s '("#f" "false" "no" "n" "0" "off" "")) #f]
[else default])]
[else default]))
(define (int-value v [default 0])
(cond [(integer? v) v]
[(number? v) (inexact->exact (round v))]
[(string? v) (or (string->number (string-trim v)) default)]
[else default]))
(define (string-value v [default ""])
(cond [(string? v) v]
[(symbol? v) (symbol->string v)]
[(number? v) (number->string v)]
[(boolean? v) (if v "#t" "#f")]
[(not v) default]
[else (format "~a" v)]))
(define (split-addresses v)
(define s (string-value v ""))
(filter (lambda (x) (not (string=? x "")))
(map string-trim (regexp-split #px"[,;]" s))))
(define (relpath-string base p)
(path->string (find-relative-path (simple-form-path base) (simple-form-path p))))
(define (flac-path? p)
(and (file-exists? p)
(let-values ([(base name dir?) (split-path p)])
(and (path? name)
(string-ci=? (bytes->string/utf-8 (or (path-get-extension name) #"")) ".flac")))))
(define (ensure-parent-directory! p)
(define-values (base name dir?) (split-path p))
(when (path? base) (make-directory* base)))
(define (alist-ref/default a k [default #f])
(define e (assoc k a))
(if e (cdr e) default))
(define (alist-set a k v)
(cons (cons k v) (filter (lambda (e) (not (equal? (car e) k))) a)))