nog een
This commit is contained in:
@@ -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
|
||||
|
||||
+11
-11
@@ -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
|
||||
(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)))
|
||||
(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))))]
|
||||
(begin
|
||||
(convert-proc path
|
||||
(ini-ref/int ini 'manager 'max-sample-rate 48000)
|
||||
(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))))
|
||||
(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 '()))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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))
|
||||
@@ -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
@@ -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
@@ -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)
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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))
|
||||
|
||||
@@ -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))
|
||||
|
||||
Reference in New Issue
Block a user