This commit is contained in:
2026-06-10 08:45:11 +02:00
parent 930903fb42
commit 3b61e358dc
10 changed files with 190 additions and 63 deletions
+5 -4
View File
@@ -21,9 +21,9 @@ absolute mount points are not stored, and path separators are always `/`.
## FLAC 48 kHz manager
The command keeps a FLAC directory tree at a maximum sample rate of 48 kHz.
Files above the configured threshold are converted synchronously by the batch process. The conversion path uses `racket-audio/audio-encoder` dynamically, so the
package can still compile on systems where the native audio libraries are not
installed yet.
Files above the configured threshold are converted in place by a direct call to
`racket-audio/audio-encoder`. The conversion code is deliberately synchronous:
no places, channels or worker protocol are used.
Run:
@@ -63,7 +63,8 @@ as keyword argument:
Metadata is copied through `racket-audio/taglib` and `racket-audio/audio-encoder`:
ordinary TagLib properties are transferred, embedded pictures are transferred,
and an additional `FLAC2OPUS` comment is written to mark the conversion.
and an additional `FLAC2OPUS` comment is written to mark the conversion. The
batch converter itself remains a simple synchronous function call.
The manager removes target files that belonged to source files which disappeared
since the previous run. It deliberately does not mirror its own root-level
+8 -8
View File
@@ -6,7 +6,7 @@
racket/path
"private/audio.rkt"
"private/manager-ini.rkt"
"private/convert-place.rkt"
"private/convert.rkt"
"private/cover-art.rkt"
"private/fingerprint.rkt"
"private/hash.rkt"
@@ -102,16 +102,16 @@
(values (summary-inc (summary-inc summary2 'skipped) 'dry-run) errors))
(begin
(info-alm "converting ~a from ~a Hz to ~a Hz" relpath sample-rate (ini-ref/int ini 'manager 'max-sample-rate 48000))
(let* ((result (convert-proc path
(begin
(convert-proc path
(ini-ref/int ini 'manager 'max-sample-rate 48000)
(ini-ref/int ini 'manager 'compression-level 5)))
(new-sample-rate (inspect-flac-proc path))
(new-signature (file-signature path ini fingerprint-proc)))
(ini-ref/int ini 'manager 'compression-level 5))
(let ([new-sample-rate (inspect-flac-proc path)]
[new-signature (file-signature path ini fingerprint-proc)])
(state-set-file! ks relpath
(state-info path new-signature 'converted new-sample-rate
(list (cons 'old-sample-rate sample-rate)
(cons 'encoder-result result))))
(values (summary-inc summary2 'converted) errors))))]
(list (cons 'old-sample-rate sample-rate))))
(values (summary-inc summary2 'converted) errors)))))]
[else
(info-alm "ok: ~a (~a Hz)" relpath sample-rate)
(state-set-file! ks relpath (state-info path signature 'ok sample-rate '()))
+4 -7
View File
@@ -10,7 +10,7 @@
"private/hash.rkt"
"private/log.rkt"
"private/mail.rkt"
"private/opus-convert-place.rkt"
"private/opus-convert.rkt"
"private/report.rkt"
"private/util.rkt")
@@ -139,10 +139,9 @@
[(flac-path? path)
(info-alm "converting ~a -> ~a at ~a kbps" relpath target-relpath kbps)
(delete-old-target-if-needed! target-dir old target-relpath)
(define result (convert-proc path target-path kbps))
(convert-proc path target-path kbps)
(flac2opus-state-set-file! ks relpath
(state-info path target-relpath signature 'converted kbps
(list (cons 'encoder-result result))))
(state-info path target-relpath signature 'converted kbps '()))
(values (summary-inc summary2 'converted) errors)]
[else
(info-alm "copying ~a -> ~a" relpath target-relpath)
@@ -168,9 +167,7 @@
(summary-inc s 'removed)))))
(define (find-source-files source-dir)
(filter (lambda (p)
(and (not (manager-temp-path? p))
(not (manager-admin-relpath? (source-relpath-string source-dir p)))))
(filter (lambda (p) (not (manager-admin-relpath? (source-relpath-string source-dir p))))
(directory-file-paths source-dir)))
(define (manage-flac2opus-tree source-directory target-directory
+43
View File
@@ -0,0 +1,43 @@
#lang racket/base
(require racket/file
racket/path
"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 (delete-file/quiet! p)
(with-handlers ([exn:fail? (lambda (_) (void))])
(when (file-exists? p) (delete-file p))))
(define (settings max-sample-rate compression-level)
(make-immutable-hash
(list (cons 'target-sample-rate max-sample-rate)
(cons 'compression-level compression-level))))
(define (call-audio-encode audio-encode in-file out-file settings progress-callback)
(if progress-callback
(audio-encode in-file out-file settings
#:encoder 'flac
#:copy-tags? #t
#:progress-callback progress-callback)
(audio-encode in-file out-file settings
#:encoder 'flac
#:copy-tags? #t)))
(define (convert-flac-to-target-in-place input-path max-sample-rate compression-level
#:progress-callback [progress-callback #f])
(define tmp-path (temp-output-path input-path))
(with-handlers ([exn:break? (lambda (e) (delete-file/quiet! tmp-path) (raise e))]
[exn:fail? (lambda (e) (delete-file/quiet! tmp-path) (raise e))])
(define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
(define result (call-audio-encode audio-encode input-path tmp-path
(settings max-sample-rate compression-level)
progress-callback))
(rename-file-or-directory tmp-path input-path #t)
result))
+112
View File
@@ -0,0 +1,112 @@
#lang racket/base
(require racket/file
racket/list
racket/path
racket/string
"util.rkt")
(provide convert-flac-to-opus)
(define conversion-note "Converted from FLAC to Opus by flac2opus-manager")
(define (temp-output-path output-path)
(define-values (base name dir?) (split-path output-path))
(define name-str (if (path? name) (path->string name) "output.opus"))
(build-path base (format ".~a.tmp-~a.opus" name-str (current-inexact-milliseconds))))
(define (delete-file/quiet! p)
(with-handlers ([exn:fail? (lambda (_) (void))])
(when (file-exists? p) (delete-file p))))
(define (list-of-strings? v)
(and (list? v) (andmap string? v)))
(define (property-key-symbol k)
(cond [(symbol? k) k]
[(string? k) (string->symbol (string-downcase k))]
[else (string->symbol (string-downcase (format "~a" k)))]))
(define (first-comment-value v)
(cond [(and (pair? v) (string? (car v))) (car v)]
[(string? v) v]
[else #f]))
(define (source-tags-data input-file)
(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-keys (dynamic-require 'racket-audio/taglib 'tags-keys))
(define tags-ref (dynamic-require 'racket-audio/taglib 'tags-ref))
(define tags-picture (dynamic-require 'racket-audio/taglib 'tags-picture))
(call-with-id3-tags
input-file
(lambda (tags)
(if (not (tags-valid? tags))
(list (cons 'properties '()) (cons 'picture #f))
(let* ((keys (sort (tags-keys tags) string<? #:key (lambda (x) (format "~a" x))))
(properties (for/list ([k (in-list keys)])
(cons (property-key-symbol k) (tags-ref tags k)))))
(list (cons 'properties properties)
(cons 'picture (tags-picture tags))))))
#:mode 'read))
(define (source-tags->settings input-file kbps)
(define data (source-tags-data input-file))
(define properties (alist-ref/default data 'properties '()))
(define picture (alist-ref/default data 'picture #f))
(define comments (make-hash))
(for ([kv (in-list properties)])
(define v (first-comment-value (cdr kv)))
(when v (hash-set! comments (car kv) v)))
(hash-set! comments 'flac2opus conversion-note)
(define settings (make-hash))
(hash-set! settings 'bitrate (* kbps 1000))
(hash-set! settings 'vbr? #t)
(hash-set! settings 'comments comments)
;; Do not put the id3-picture struct in settings. It makes the encoder result
;; harder to store or serialize, and the picture is copied explicitly below.
(values settings properties picture))
(define (copy-all-tag-properties! output-file properties picture)
(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-set-values! (dynamic-require 'racket-audio/taglib 'tags-set-values!))
(define tags-set! (dynamic-require 'racket-audio/taglib 'tags-set!))
(define tags-picture! (dynamic-require 'racket-audio/taglib 'tags-picture!))
(define tags-save! (dynamic-require 'racket-audio/taglib 'tags-save!))
(call-with-id3-tags
output-file
(lambda (tags)
(when (tags-valid? tags)
(for ([kv (in-list properties)])
(define v (cdr kv))
(cond [(list-of-strings? v) (tags-set-values! tags (car kv) v)]
[(string? v) (tags-set! tags (car kv) v)]
[else (void)]))
(tags-set! tags 'flac2opus conversion-note)
(unless (eq? picture #f) (tags-picture! tags picture))
(tags-save! tags)))
#:mode 'read-write))
(define (call-audio-encode audio-encode in-file out-file settings progress-callback)
(if progress-callback
(audio-encode in-file out-file settings
#:encoder 'opus
#:copy-tags? #f
#:progress-callback progress-callback)
(audio-encode in-file out-file settings
#:encoder 'opus
#:copy-tags? #f)))
(define (convert-flac-to-opus input-path output-path kbps #:progress-callback [progress-callback #f])
(define tmp-path (temp-output-path output-path))
(ensure-parent-directory! tmp-path)
(with-handlers ([exn:break? (lambda (e) (delete-file/quiet! tmp-path) (raise e))]
[exn:fail? (lambda (e) (delete-file/quiet! tmp-path) (raise e))])
(define-values (settings properties picture) (source-tags->settings input-path kbps))
(define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
(define result (call-audio-encode audio-encode input-path tmp-path settings progress-callback))
(copy-all-tag-properties! tmp-path properties picture)
(ensure-parent-directory! output-path)
(rename-file-or-directory tmp-path output-path #t)
result))
+2 -25
View File
@@ -7,34 +7,11 @@
(provide find-flac-files
find-regular-files)
(define (directory-list/quiet dir)
(with-handlers ([exn:fail? (lambda (_) '())])
(directory-list dir #:build? #t)))
(define (directory-exists?/quiet p)
(with-handlers ([exn:fail? (lambda (_) #f)])
(directory-exists? p)))
(define (file-exists?/quiet p)
(with-handlers ([exn:fail? (lambda (_) #f)])
(file-exists? p)))
(define (sort-paths paths)
(sort paths string<? #:key path->string))
(define (find-regular-files base-dir)
;; Do not use racket/file:find-files here. On Windows UNC trees, especially
;; with long paths, fold-files can raise "path disappeared" for a single
;; entry and abort the whole scan. This walker treats entries that disappear,
;; are inaccessible, or cannot be represented by the platform path layer as a
;; skipped entry and continues the scan.
(define root (filesystem-path base-dir))
(let loop ([dir root] [acc '()])
(for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))])
(cond [(directory-exists?/quiet p) (loop p acc)]
[(file-exists?/quiet p) (cons p acc)]
[else acc]))))
(sort-paths (directory-file-paths base-dir)))
(define (find-flac-files base-dir)
(sort-paths (filter (lambda (p) (and (flac-path? p) (not (manager-temp-path? p))))
(find-regular-files base-dir))))
(filter flac-path? (find-regular-files base-dir)))
+6 -11
View File
@@ -113,22 +113,17 @@
(define (file-exists?/quiet p)
(with-handlers ([exn:fail? (lambda (_) #f)]) (file-exists? p)))
(define (path-file-name-string p)
(let-values ([(base name dir?) (split-path p)])
(and (path? name) (path->string name))))
(define (manager-temp-path? p)
(define name (path-file-name-string p))
(and name
(string-prefix? name ".")
(regexp-match? #rx"\\.tmp-[0-9.]+\\.(flac|opus)$" name)))
(define (flac-path? p)
(and (file-exists?/quiet p) (extension-ci=? p ".flac")))
(define (opus-path? p)
(and (file-exists?/quiet p) (extension-ci=? p ".opus")))
(define (manager-temp-path? p)
(define-values (_base name _dir?) (split-path p))
(and (path? name)
(regexp-match? #rx"^\\..*\\.tmp-[0-9.]+\\.(flac|opus)$" (path->string name))))
(define (regular-file-path? p)
(file-exists?/quiet p))
@@ -150,7 +145,7 @@
(let loop ([dir root] [acc '()])
(for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))])
(cond [(directory-exists?/quiet p) (loop p acc)]
[(file-exists?/quiet p) (cons p acc)]
[(and (file-exists?/quiet p) (not (manager-temp-path? p))) (cons p acc)]
[else acc]))))
(define (replace-path-extension p ext)
+5 -3
View File
@@ -24,9 +24,10 @@ so it can share the same database with the 48 kHz manager.
@section{FLAC 48 kHz manager}
The tool @filepath{flac-48khz-manager.rkt} keeps a FLAC tree at a maximum sample
rate of 48 kHz. Files with a higher sample rate are converted synchronously by the batch process. The conversion path uses
@racketmodname[racket-audio/audio-encoder] dynamically, so the manager module can
still be compiled on systems where the native audio libraries are not available.
rate of 48 kHz. Files with a higher sample rate are converted in place by a
direct call to @racketmodname[racket-audio/audio-encoder]. The batch conversion
path is deliberately synchronous; it does not use places, channels or a worker
protocol.
Run the manager as:
@@ -60,6 +61,7 @@ Metadata is copied through @racketmodname[racket-audio/taglib] and
@racketmodname[racket-audio/audio-encoder]. TagLib properties and embedded
pictures are transferred to the Opus file. The manager also writes a
@tt{FLAC2OPUS} comment indicating that the file was converted by the manager.
The conversion function is a normal synchronous function call.
When a source file disappears, the corresponding target file is removed on the
next run. The manager does not mirror its own root-level administration files.
+1 -1
View File
@@ -58,7 +58,7 @@
(set! convert-count (add1 convert-count))
(call-with-output-file p #:exists 'replace
(lambda (out) (fprintf out "converted to ~a compression ~a" rate compression)))
(list (cons 'mock #t) (cons 'target-sample-rate rate)))
(lambda () rate))
(define first-summary
(manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert))
+1 -1
View File
@@ -33,7 +33,7 @@
(make-directory* (let-values ([(base name dir?) (split-path dst)]) base))
(call-with-output-file dst #:exists 'replace
(lambda (o) (fprintf o "opus from ~a at ~a" (path->string src) kbps)))
(list (cons 'mock #t) (cons 'kbps kbps)))
(lambda () kbps))
(define first-summary
(manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))