Cleanup of vibe code and replacement by self coded audio manager.
This commit is contained in:
@@ -1,8 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require "fingerprint.rkt")
|
||||
|
||||
(provide inspect-flac-sample-rate)
|
||||
|
||||
(define (inspect-flac-sample-rate path)
|
||||
(flac-streaminfo-sample-rate (read-flac-streaminfo path)))
|
||||
@@ -1,43 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/file
|
||||
racket/path)
|
||||
|
||||
(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->hash max-sample-rate compression-level)
|
||||
(make-immutable-hash
|
||||
(list (cons 'target-sample-rate max-sample-rate)
|
||||
(cons 'compression-level compression-level))))
|
||||
|
||||
(define (delete-file/quiet path)
|
||||
(with-handlers ([exn:fail? (lambda (_) #f)])
|
||||
(when (file-exists? path) (delete-file path))))
|
||||
|
||||
(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))
|
||||
(define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
|
||||
(with-handlers ([exn:break?
|
||||
(lambda (e)
|
||||
(delete-file/quiet tmp-path)
|
||||
(raise e))]
|
||||
[exn:fail?
|
||||
(lambda (e)
|
||||
(delete-file/quiet tmp-path)
|
||||
(error 'convert-flac-to-target-in-place
|
||||
"conversion failed for ~a: ~a" input-path (exn-message e)))])
|
||||
(define result
|
||||
(audio-encode (path->string input-path)
|
||||
(path->string tmp-path)
|
||||
(settings->hash max-sample-rate compression-level)
|
||||
#:encoder 'flac
|
||||
#:copy-tags? #t
|
||||
#:progress-callback progress-callback))
|
||||
(rename-file-or-directory tmp-path input-path #t)
|
||||
result))
|
||||
@@ -1,43 +0,0 @@
|
||||
#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))
|
||||
@@ -1,55 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/file
|
||||
racket/list
|
||||
racket/path
|
||||
racket/string)
|
||||
|
||||
(provide sidecar-cover-path
|
||||
ensure-flac-sidecar-picture!)
|
||||
|
||||
(define cover-names '("cover.jpg" "folder.jpg" "cover.png" "folder.png"))
|
||||
|
||||
(define (path-name-ci=? p s)
|
||||
(define-values (_base name _dir?) (split-path p))
|
||||
(and (path? name) (string-ci=? (path->string name) s)))
|
||||
|
||||
(define (sidecar-cover-path audio-path)
|
||||
(define-values (dir _name _dir?) (split-path audio-path))
|
||||
(and (path? dir)
|
||||
(for/or ([wanted (in-list cover-names)])
|
||||
(or (let ([candidate (build-path dir wanted)])
|
||||
(and (file-exists? candidate) candidate))
|
||||
(for/or ([p (in-list (with-handlers ([exn:fail? (lambda (_) '())])
|
||||
(directory-list dir #:build? #t)))])
|
||||
(and (file-exists? p) (path-name-ci=? p wanted) p))))))
|
||||
|
||||
(define (cover-mimetype path)
|
||||
(define ext (let-values ([(base name dir?) (split-path path)])
|
||||
(and (path? name) (path-get-extension name))))
|
||||
(cond [(and ext (member (string-downcase (bytes->string/utf-8 ext)) '(".jpg" ".jpeg"))) "image/jpeg"]
|
||||
[(and ext (string-ci=? (bytes->string/utf-8 ext) ".png")) "image/png"]
|
||||
[else (error 'cover-mimetype "unsupported cover image extension: ~a" path)]))
|
||||
|
||||
(define (ensure-flac-sidecar-picture! flac-path)
|
||||
(define cover (sidecar-cover-path flac-path))
|
||||
(and cover
|
||||
(let ()
|
||||
(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-picture (dynamic-require 'racket-audio/taglib 'tags-picture))
|
||||
(define tags-picture! (dynamic-require 'racket-audio/taglib 'tags-picture!))
|
||||
(define tags-save! (dynamic-require 'racket-audio/taglib 'tags-save!))
|
||||
(define make-tags-picture (dynamic-require 'racket-audio/taglib 'make-tags-picture))
|
||||
(call-with-id3-tags
|
||||
flac-path
|
||||
(lambda (tags)
|
||||
(cond [(not (tags-valid? tags)) #f]
|
||||
[(tags-picture tags) #f]
|
||||
[else
|
||||
(define picture (make-tags-picture (cover-mimetype cover) 3 (file->bytes cover)
|
||||
#:description "Front cover"))
|
||||
(tags-picture! tags picture)
|
||||
(tags-save! tags)
|
||||
cover]))
|
||||
#:mode 'read-write))))
|
||||
@@ -8,7 +8,7 @@
|
||||
|
||||
(provide make-file-walker
|
||||
make-file-admin
|
||||
fw-add-filter
|
||||
fw-add-step
|
||||
os-path
|
||||
)
|
||||
|
||||
@@ -138,11 +138,11 @@
|
||||
f))
|
||||
)
|
||||
|
||||
(define (fw-add-filter fw filter-func)
|
||||
(define (fw-add-step fw step-func)
|
||||
(λ ()
|
||||
(let-values (((base-path path info) (fw)))
|
||||
(if (eq? info #f)
|
||||
(values #f #f #f)
|
||||
(filter-func base-path path info))))
|
||||
(step-func base-path path info))))
|
||||
)
|
||||
|
||||
|
||||
@@ -1,177 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require file/sha1
|
||||
racket/list
|
||||
racket/port
|
||||
racket/string
|
||||
"util.rkt")
|
||||
|
||||
(provide read-flac-streaminfo
|
||||
flac-streaminfo-sample-rate
|
||||
flac-streaminfo-fingerprint
|
||||
flac-taglib-fingerprint)
|
||||
|
||||
(struct flac-streaminfo
|
||||
(min-blocksize max-blocksize min-framesize max-framesize sample-rate channels bits-per-sample total-samples audio-md5)
|
||||
#:transparent)
|
||||
|
||||
(define (u16be b i)
|
||||
(+ (arithmetic-shift (bytes-ref b i) 8)
|
||||
(bytes-ref b (+ i 1))))
|
||||
|
||||
(define (u24be b i)
|
||||
(+ (arithmetic-shift (bytes-ref b i) 16)
|
||||
(arithmetic-shift (bytes-ref b (+ i 1)) 8)
|
||||
(bytes-ref b (+ i 2))))
|
||||
|
||||
(define (u64be b i)
|
||||
(for/fold ([n 0]) ([j (in-range i (+ i 8))])
|
||||
(+ (arithmetic-shift n 8) (bytes-ref b j))))
|
||||
|
||||
(define (hex-bytes b)
|
||||
(bytes->hex-string b))
|
||||
|
||||
(define (sha256-string s)
|
||||
(bytes->hex-string (sha256-bytes (string->bytes/utf-8 s))))
|
||||
|
||||
(define (read-exact-bytes who in n)
|
||||
(define b (read-bytes n in))
|
||||
(unless (and (bytes? b) (= (bytes-length b) n))
|
||||
(error who "unexpected end of file"))
|
||||
b)
|
||||
|
||||
(define (syncsafe-byte? b)
|
||||
(< b #x80))
|
||||
|
||||
(define (u28-syncsafe b i)
|
||||
(unless (and (syncsafe-byte? (bytes-ref b i))
|
||||
(syncsafe-byte? (bytes-ref b (+ i 1)))
|
||||
(syncsafe-byte? (bytes-ref b (+ i 2)))
|
||||
(syncsafe-byte? (bytes-ref b (+ i 3))))
|
||||
(error 'read-flac-streaminfo "invalid ID3v2 syncsafe size"))
|
||||
(+ (arithmetic-shift (bytes-ref b i) 21)
|
||||
(arithmetic-shift (bytes-ref b (+ i 1)) 14)
|
||||
(arithmetic-shift (bytes-ref b (+ i 2)) 7)
|
||||
(bytes-ref b (+ i 3))))
|
||||
|
||||
(define (read-flac-marker path in)
|
||||
(define first (read-exact-bytes 'read-flac-streaminfo in 4))
|
||||
(cond [(bytes=? first #"fLaC") 'native]
|
||||
[(and (= (bytes-ref first 0) (char->integer #\I))
|
||||
(= (bytes-ref first 1) (char->integer #\D))
|
||||
(= (bytes-ref first 2) (char->integer #\3)))
|
||||
(let* ([_0 (file-position in 0)]
|
||||
[id3-header (read-exact-bytes 'read-flac-streaminfo in 10)]
|
||||
[flags (bytes-ref id3-header 5)]
|
||||
[tag-size (u28-syncsafe id3-header 6)]
|
||||
[footer-size (if (not (zero? (bitwise-and flags #x10))) 10 0)]
|
||||
[_1 (file-position in (+ 10 tag-size footer-size))]
|
||||
[marker (read-exact-bytes 'read-flac-streaminfo in 4)])
|
||||
(unless (bytes=? marker #"fLaC")
|
||||
(error 'read-flac-streaminfo
|
||||
"ID3v2 prefix found, but no FLAC marker after prefix: ~a"
|
||||
path))
|
||||
'id3v2-prefixed)]
|
||||
[else
|
||||
(error 'read-flac-streaminfo "not a native FLAC file: ~a" path)]))
|
||||
|
||||
(define (read-flac-streaminfo path)
|
||||
(call-with-input-file path
|
||||
(lambda (in)
|
||||
(read-flac-marker path in)
|
||||
(let loop ()
|
||||
(define header (read-exact-bytes 'read-flac-streaminfo in 4))
|
||||
(define last? (not (zero? (bitwise-and (bytes-ref header 0) #x80))))
|
||||
(define block-type (bitwise-and (bytes-ref header 0) #x7f))
|
||||
(define len (u24be header 1))
|
||||
(cond [(= block-type 0)
|
||||
(unless (= len 34)
|
||||
(error 'read-flac-streaminfo "invalid STREAMINFO length ~a for ~a" len path))
|
||||
(define b (read-exact-bytes 'read-flac-streaminfo in len))
|
||||
(define packed (u64be b 10))
|
||||
(define sample-rate (bitwise-and (arithmetic-shift packed -44) #xfffff))
|
||||
(define channels (+ 1 (bitwise-and (arithmetic-shift packed -41) #x7)))
|
||||
(define bits-per-sample (+ 1 (bitwise-and (arithmetic-shift packed -36) #x1f)))
|
||||
(define total-samples (bitwise-and packed #xfffffffff))
|
||||
(flac-streaminfo (u16be b 0)
|
||||
(u16be b 2)
|
||||
(u24be b 4)
|
||||
(u24be b 7)
|
||||
sample-rate
|
||||
channels
|
||||
bits-per-sample
|
||||
total-samples
|
||||
(subbytes b 18 34))]
|
||||
[last? (error 'read-flac-streaminfo "STREAMINFO block not found in ~a" path)]
|
||||
[else
|
||||
(define skipped (read-bytes len in))
|
||||
(unless (and (bytes? skipped) (= (bytes-length skipped) len))
|
||||
(error 'read-flac-streaminfo "unexpected end of file while skipping metadata block"))
|
||||
(loop)])))
|
||||
#:mode 'binary))
|
||||
|
||||
(define (flac-streaminfo-fingerprint-data path)
|
||||
(define si (read-flac-streaminfo path))
|
||||
(list (cons 'kind 'flac-streaminfo)
|
||||
(cons 'min-blocksize (flac-streaminfo-min-blocksize si))
|
||||
(cons 'max-blocksize (flac-streaminfo-max-blocksize si))
|
||||
(cons 'min-framesize (flac-streaminfo-min-framesize si))
|
||||
(cons 'max-framesize (flac-streaminfo-max-framesize si))
|
||||
(cons 'sample-rate (flac-streaminfo-sample-rate si))
|
||||
(cons 'channels (flac-streaminfo-channels si))
|
||||
(cons 'bits-per-sample (flac-streaminfo-bits-per-sample si))
|
||||
(cons 'total-samples (flac-streaminfo-total-samples si))
|
||||
(cons 'audio-md5 (hex-bytes (flac-streaminfo-audio-md5 si)))))
|
||||
|
||||
(define (canonical-value v)
|
||||
(cond [(string? v) v]
|
||||
[(symbol? v) (symbol->string v)]
|
||||
[(number? v) v]
|
||||
[(boolean? v) v]
|
||||
[(bytes? v) (list 'bytes-sha256 (bytes-length v) (hex-bytes (sha256-bytes v)))]
|
||||
[(list? v) (map canonical-value v)]
|
||||
[(eq? v #f) #f]
|
||||
[else (format "~s" v)]))
|
||||
|
||||
(define (taglib-fingerprint-data 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-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))
|
||||
(define id3-picture? (dynamic-require 'racket-audio/taglib 'id3-picture?))
|
||||
(define id3-picture-mimetype (dynamic-require 'racket-audio/taglib 'id3-picture-mimetype))
|
||||
(define id3-picture-kind (dynamic-require 'racket-audio/taglib 'id3-picture-kind))
|
||||
(define id3-picture-size (dynamic-require 'racket-audio/taglib 'id3-picture-size))
|
||||
(define id3-picture-bytes (dynamic-require 'racket-audio/taglib 'id3-picture-bytes))
|
||||
(define id3-picture-description (dynamic-require 'racket-audio/taglib 'id3-picture-description))
|
||||
(call-with-id3-tags
|
||||
path
|
||||
(lambda (tags)
|
||||
(unless (tags-valid? tags)
|
||||
(error 'taglib-fingerprint-data "invalid tags for ~a" path))
|
||||
(define keys (sort (map canonical-value (tags-keys tags)) string<? #:key (lambda (x) (format "~a" x))))
|
||||
(define values
|
||||
(for/list ([k (in-list keys)])
|
||||
(cons k (canonical-value (tags-ref tags k)))))
|
||||
(define picture (tags-picture tags))
|
||||
(define picture-data
|
||||
(if (and picture (id3-picture? picture))
|
||||
(list (cons 'mimetype (id3-picture-mimetype picture))
|
||||
(cons 'kind (id3-picture-kind picture))
|
||||
(cons 'size (id3-picture-size picture))
|
||||
(cons 'description (id3-picture-description picture))
|
||||
(cons 'bytes-sha256 (hex-bytes (sha256-bytes (id3-picture-bytes picture)))))
|
||||
#f))
|
||||
(list (cons 'kind 'taglib)
|
||||
(cons 'properties values)
|
||||
(cons 'picture picture-data)))
|
||||
#:mode 'read))
|
||||
|
||||
(define (flac-taglib-fingerprint path)
|
||||
(sha256-string (format "~s" (list (flac-streaminfo-fingerprint-data path)
|
||||
(taglib-fingerprint-data path)))))
|
||||
|
||||
(define (flac-streaminfo-fingerprint path)
|
||||
(sha256-string (format "~s" (flac-streaminfo-fingerprint-data path))))
|
||||
|
||||
@@ -1,54 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/list
|
||||
keystore
|
||||
"util.rkt")
|
||||
|
||||
(provide open-flac2opus-state
|
||||
flac2opus-state-get-file
|
||||
flac2opus-state-set-file!
|
||||
flac2opus-state-drop-file!
|
||||
flac2opus-state-known-relpaths)
|
||||
|
||||
(define prefix "flac2opus:file:")
|
||||
|
||||
(define (open-flac2opus-state state-file)
|
||||
(ks-open state-file))
|
||||
|
||||
(define (file-state-key relpath)
|
||||
(string-append prefix (normalize-relpath-string relpath)))
|
||||
|
||||
(define (legacy-file-state-key relpath)
|
||||
(string-append prefix (legacy-backslash-relpath-string relpath)))
|
||||
|
||||
(define (ks-drop/quiet! ks key)
|
||||
(with-handlers ([exn:fail? (lambda (_) (void))])
|
||||
(ks-drop! ks key)))
|
||||
|
||||
(define (flac2opus-state-get-file ks relpath [default #f])
|
||||
(define key (file-state-key relpath))
|
||||
(define legacy-key (legacy-file-state-key relpath))
|
||||
(define missing (gensym 'missing))
|
||||
(define value (ks-get ks key missing))
|
||||
(cond [(not (eq? value missing)) value]
|
||||
[(equal? key legacy-key) default]
|
||||
[else (ks-get ks legacy-key default)]))
|
||||
|
||||
(define (flac2opus-state-set-file! ks relpath value)
|
||||
(define key (file-state-key relpath))
|
||||
(define legacy-key (legacy-file-state-key relpath))
|
||||
(ks-set! ks key value)
|
||||
(unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
|
||||
|
||||
(define (flac2opus-state-drop-file! ks relpath)
|
||||
(define key (file-state-key relpath))
|
||||
(define legacy-key (legacy-file-state-key relpath))
|
||||
(ks-drop/quiet! ks key)
|
||||
(unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
|
||||
|
||||
(define (flac2opus-state-known-relpaths ks)
|
||||
(remove-duplicates
|
||||
(map (lambda (k)
|
||||
(normalize-relpath-string (substring k (string-length prefix))))
|
||||
(ks-keys-glob ks (string-append prefix "*")))
|
||||
equal?))
|
||||
@@ -1,21 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
; No external crypto package dependency: sha256-bytes is provided by racket/base.
|
||||
(require file/sha1
|
||||
file/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))
|
||||
@@ -1,77 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/file
|
||||
racket/path
|
||||
simple-ini
|
||||
"util.rkt")
|
||||
|
||||
(provide manager-ini-file
|
||||
manager-state-file
|
||||
ensure-default-manager-ini!
|
||||
load-manager-ini
|
||||
ini-ref/bool
|
||||
ini-ref/int
|
||||
ini-ref/string
|
||||
ini-ref/path
|
||||
ini-ref/addresses)
|
||||
|
||||
(define (manager-ini-file base-dir*)
|
||||
(build-path (filesystem-path base-dir*) ".flac-48khz-manager.ini"))
|
||||
|
||||
(define (manager-state-file base-dir*)
|
||||
(build-path (filesystem-path base-dir*) ".music-info.db"))
|
||||
|
||||
(define (ensure-default-manager-ini! 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 'change-detection "flac-taglib")
|
||||
(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 'opus-manager 'log-file ".flac2opus-manager.log")
|
||||
(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 (load-manager-ini base-dir*)
|
||||
(define ini-file (manager-ini-file base-dir*))
|
||||
(ensure-default-manager-ini! ini-file)
|
||||
(file->ini ini-file))
|
||||
|
||||
(define (ini-ref/bool ini section key default)
|
||||
(bool-value (ini-get ini section key default) default))
|
||||
|
||||
(define (ini-ref/int ini section key default)
|
||||
(int-value (ini-get ini section key default) default))
|
||||
|
||||
(define (ini-ref/string ini section key default)
|
||||
(string-value (ini-get ini section key default) default))
|
||||
|
||||
(define (resolve-ini-path base-dir v default)
|
||||
(define p (string-value v default))
|
||||
(cond [(path-string? p)
|
||||
(define bp (string->path p))
|
||||
(if (absolute-path? bp) bp (build-path base-dir bp))]
|
||||
[else (build-path base-dir default)]))
|
||||
|
||||
(define (ini-ref/path ini base-dir section key default)
|
||||
(resolve-ini-path (filesystem-path base-dir)
|
||||
(ini-get ini section key default)
|
||||
default))
|
||||
|
||||
(define (ini-ref/addresses ini section key default)
|
||||
(split-addresses (ini-get ini section key default)))
|
||||
@@ -1,116 +0,0 @@
|
||||
#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 (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)
|
||||
(unless (eq? picture #f) (hash-set! settings 'picture picture))
|
||||
(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 (delete-file/quiet path)
|
||||
(with-handlers ([exn:fail? (lambda (_) #f)])
|
||||
(when (file-exists? path) (delete-file path))))
|
||||
|
||||
(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)
|
||||
(error 'convert-flac-to-opus
|
||||
"conversion failed for ~a: ~a" input-path (exn-message e)))])
|
||||
(define-values (settings properties picture)
|
||||
(source-tags->settings (path->string input-path) kbps))
|
||||
(define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
|
||||
(define result
|
||||
(audio-encode (path->string input-path)
|
||||
(path->string tmp-path)
|
||||
settings
|
||||
#:encoder 'opus
|
||||
#:copy-tags? #f
|
||||
#:progress-callback progress-callback))
|
||||
(copy-all-tag-properties! (path->string tmp-path) properties picture)
|
||||
(ensure-parent-directory! output-path)
|
||||
(rename-file-or-directory tmp-path output-path #t)
|
||||
result))
|
||||
@@ -1,112 +0,0 @@
|
||||
#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))
|
||||
@@ -1,57 +0,0 @@
|
||||
#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 copied 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 "<"))
|
||||
(regexp-replace* #rx">" z ">"))
|
||||
|
||||
(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))
|
||||
@@ -1,17 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/list
|
||||
racket/path
|
||||
"util.rkt")
|
||||
|
||||
(provide find-flac-files
|
||||
find-regular-files)
|
||||
|
||||
(define (sort-paths paths)
|
||||
(sort paths string<? #:key path->string))
|
||||
|
||||
(define (find-regular-files base-dir)
|
||||
(sort-paths (directory-file-paths base-dir)))
|
||||
|
||||
(define (find-flac-files base-dir)
|
||||
(filter flac-path? (find-regular-files base-dir)))
|
||||
@@ -1,55 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/list
|
||||
keystore
|
||||
"util.rkt")
|
||||
|
||||
(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 (normalize-relpath-string relpath)))
|
||||
|
||||
(define (legacy-file-state-key relpath)
|
||||
(string-append prefix (legacy-backslash-relpath-string relpath)))
|
||||
|
||||
(define (ks-drop/quiet! ks key)
|
||||
(with-handlers ([exn:fail? (lambda (_) (void))])
|
||||
(ks-drop! ks key)))
|
||||
|
||||
(define (state-get-file ks relpath [default #f])
|
||||
(define key (file-state-key relpath))
|
||||
(define legacy-key (legacy-file-state-key relpath))
|
||||
(define missing (gensym 'missing))
|
||||
(define value (ks-get ks key missing))
|
||||
(cond [(not (eq? value missing)) value]
|
||||
[(equal? key legacy-key) default]
|
||||
[else (ks-get ks legacy-key default)]))
|
||||
|
||||
(define (state-set-file! ks relpath value)
|
||||
(define key (file-state-key relpath))
|
||||
(define legacy-key (legacy-file-state-key relpath))
|
||||
(ks-set! ks key value)
|
||||
(unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
|
||||
|
||||
(define (state-drop-file! ks relpath)
|
||||
(define key (file-state-key relpath))
|
||||
(define legacy-key (legacy-file-state-key relpath))
|
||||
(ks-drop/quiet! ks key)
|
||||
(unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
|
||||
|
||||
(define (state-known-relpaths ks)
|
||||
(remove-duplicates
|
||||
(map (lambda (k)
|
||||
(normalize-relpath-string (substring k (string-length prefix))))
|
||||
(ks-keys-glob ks (string-append prefix "*")))
|
||||
equal?))
|
||||
Reference in New Issue
Block a user