Cleanup of vibe code and replacement by self coded audio manager.
This commit is contained in:
+27
-13
@@ -41,7 +41,9 @@
|
||||
(processed-kind (make-hash))
|
||||
(base-rate (ini-get ini 'flac 'max-khz 48000))
|
||||
(dirs-logged -1)
|
||||
(known-exts '(mp3 flac opus mp4 m4a mpg jpg jpeg png pdf))
|
||||
(known-audio-exts '(mp3 flac opus mp4 mp4a mpg ape wav))
|
||||
(known-exts (append known-audio-exts
|
||||
'(jpg jpeg png pdf)))
|
||||
(unknown-exts '())
|
||||
)
|
||||
|
||||
@@ -123,14 +125,16 @@
|
||||
(values base-path path info)))
|
||||
|
||||
(define (flac-with-id3 base-path path info)
|
||||
(if (needs-processing? path info)
|
||||
(when (eq? (hash-ref info 'ext) 'flac)
|
||||
(if (or (needs-processing? path info)
|
||||
(eq? (hash-ref info 'sniffed #f) #f))
|
||||
(let ((ext (hash-ref info 'ext)))
|
||||
(when (memq ext known-audio-exts)
|
||||
(let ((sniffed (audio-sniff-format path)))
|
||||
(hash-set! info 'sniffed sniffed)
|
||||
(when (flac-id3? info)
|
||||
(rep-id3 path))
|
||||
)
|
||||
)
|
||||
))
|
||||
(when (flac-id3? info)
|
||||
(rep-id3 path))
|
||||
)
|
||||
@@ -156,7 +160,11 @@
|
||||
(info-am "Need to convert flac file ~a (rate = ~a)" path rate)
|
||||
(rep-flac (format "Convert ~a from ~a to ~a\n" path rate base-rate))
|
||||
(if (convert-flac-to-rate path base-rate)
|
||||
(begin
|
||||
(hash-set! info 'khz base-rate)
|
||||
(hash-set! info 'size (file-size path))
|
||||
(hash-set! info 'mtime (file-or-directory-modify-seconds path))
|
||||
)
|
||||
(begin
|
||||
(err-am " Cannot convert!")
|
||||
(rep-flac " CANNOT CONVERT!")))
|
||||
@@ -187,6 +195,8 @@
|
||||
(tags-picture! tags cover)
|
||||
(tags-save! tags))
|
||||
#:mode 'read-write))
|
||||
(hash-set! info 'size (file-size path))
|
||||
(hash-set! info 'mtime (file-or-directory-modify-seconds path))
|
||||
(info-am " Picture set")
|
||||
(set! pictures-set (+ pictures-set 1))
|
||||
)
|
||||
@@ -252,7 +262,11 @@
|
||||
(when (deleted? info)
|
||||
(let ((path-part (get-path-part info)))
|
||||
(unless (eq? path-part #f)
|
||||
(let ((rm-path (build-path opus-path path-part)))
|
||||
(let ((rm-path (if (flac? info)
|
||||
(path-replace-extension
|
||||
(build-path opus-path path-part)
|
||||
#".opus")
|
||||
(build-path opus-path path-part))))
|
||||
(delete-directory/files rm-path #:must-exist? #f)
|
||||
(let ((normalized-sub-path (hash-ref info 'path)))
|
||||
(hash-remove! file-db-hash normalized-sub-path))
|
||||
@@ -346,14 +360,14 @@
|
||||
(sl-set-log-level log-level)
|
||||
|
||||
(let ((fw (make-file-admin music-path file-db-hash)))
|
||||
(set! fw (fw-add-filter fw adjust-ext))
|
||||
(set! fw (fw-add-filter fw flac-with-id3))
|
||||
(set! fw (fw-add-filter fw flac-khz-bits))
|
||||
(set! fw (fw-add-filter fw flac-convert))
|
||||
(set! fw (fw-add-filter fw flac-picture))
|
||||
(set! fw (fw-add-filter fw to-opus))
|
||||
(set! fw (fw-add-filter fw deleter))
|
||||
(set! fw (fw-add-filter fw log-processed-file))
|
||||
(set! fw (fw-add-step fw adjust-ext))
|
||||
(set! fw (fw-add-step fw flac-with-id3))
|
||||
(set! fw (fw-add-step fw flac-khz-bits))
|
||||
(set! fw (fw-add-step fw flac-convert))
|
||||
(set! fw (fw-add-step fw flac-picture))
|
||||
(set! fw (fw-add-step fw to-opus))
|
||||
(set! fw (fw-add-step fw deleter))
|
||||
(set! fw (fw-add-step fw log-processed-file))
|
||||
(let loop ()
|
||||
(let-values (((base-path path info) (fw)))
|
||||
(if (eq? info #f)
|
||||
|
||||
@@ -1,167 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/cmdline
|
||||
racket/file
|
||||
racket/list
|
||||
racket/path
|
||||
"private/audio.rkt"
|
||||
"private/manager-ini.rkt"
|
||||
"private/convert.rkt"
|
||||
"private/cover-art.rkt"
|
||||
"private/fingerprint.rkt"
|
||||
"private/hash.rkt"
|
||||
"private/log.rkt"
|
||||
"private/mail.rkt"
|
||||
"private/report.rkt"
|
||||
"private/scan.rkt"
|
||||
"private/state.rkt"
|
||||
"private/util.rkt")
|
||||
|
||||
(provide manage-flac-tree
|
||||
summary->lines)
|
||||
|
||||
(define (quick-file-info path)
|
||||
(list (cons 'size (file-size path))
|
||||
(cons 'mtime (file-or-directory-modify-seconds path))))
|
||||
|
||||
(define (same-quick-state? old path)
|
||||
(and old
|
||||
(equal? (alist-ref/default old 'size #f) (file-size path))
|
||||
(equal? (alist-ref/default old 'mtime #f) (file-or-directory-modify-seconds path))
|
||||
(not (equal? (alist-ref/default old 'status #f) 'error))))
|
||||
|
||||
(define (same-signature-state? old signature)
|
||||
(and old
|
||||
(equal? (alist-ref/default old 'signature #f) signature)
|
||||
(not (equal? (alist-ref/default old 'status #f) 'error))))
|
||||
|
||||
(define (file-signature path ini fingerprint-proc)
|
||||
(define mode (string-downcase (ini-ref/string ini 'manager 'change-detection "flac-taglib")))
|
||||
(define hash-algorithm (string-downcase (ini-ref/string ini 'manager 'hash-algorithm "sha256")))
|
||||
(cond [(member mode '("hash" "sha256" "full-hash" "full-sha256"))
|
||||
(string-append "file:" hash-algorithm ":" (file-digest path hash-algorithm))]
|
||||
[(member mode '("mtime-size" "quick"))
|
||||
(format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))]
|
||||
[(member mode '("flac" "flac-streaminfo"))
|
||||
(string-append "flac-streaminfo:" (flac-streaminfo-fingerprint path))]
|
||||
[(or (member mode '("flac-taglib" "taglib+flac" "taglib-flac")) (not mode))
|
||||
(string-append "flac-taglib:" (fingerprint-proc path))]
|
||||
[else
|
||||
(error 'file-signature "unsupported change-detection mode: ~a" mode)]))
|
||||
|
||||
(define (state-info path signature status sample-rate extra)
|
||||
(append (quick-file-info path)
|
||||
(list (cons 'signature signature)
|
||||
(cons 'status status)
|
||||
(cons 'sample-rate sample-rate))
|
||||
extra))
|
||||
|
||||
(define (maybe-set-sidecar-picture! path relpath)
|
||||
(with-handlers ([exn:fail? (lambda (e)
|
||||
(warn-alm "could not set sidecar cover for ~a: ~a" relpath (exn-message e))
|
||||
#f)])
|
||||
(define cover (ensure-flac-sidecar-picture! path))
|
||||
(when cover (info-alm "embedded sidecar cover in ~a from ~a" relpath cover))
|
||||
cover))
|
||||
|
||||
(define (process-one-file ks ini path relpath inspect-flac-proc fingerprint-proc convert-proc summary errors)
|
||||
;; Only invokes TagLib when a sidecar cover/folder image exists in the same directory.
|
||||
;; This keeps the cheap mtime/size fast path cheap for most directories, but still
|
||||
;; lets the manager repair missing embedded artwork before fingerprinting.
|
||||
(maybe-set-sidecar-picture! path relpath)
|
||||
(define old (state-get-file ks relpath #f))
|
||||
(cond [(same-quick-state? old path)
|
||||
(info-alm "unchanged: ~a" relpath)
|
||||
(values (summary-inc (summary-inc summary 'seen) 'unchanged) errors)]
|
||||
[else
|
||||
(define summary1 (summary-inc (summary-inc summary 'seen) 'processed))
|
||||
(define summary2 (if old (summary-inc summary1 'changed) (summary-inc summary1 'new)))
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (e)
|
||||
(err-alm "error for ~a: ~a" relpath (exn-message e))
|
||||
(state-set-file! ks relpath
|
||||
(append (quick-file-info path)
|
||||
(list (cons 'status 'error)
|
||||
(cons 'message (exn-message e)))))
|
||||
(values (summary-inc summary2 'errors)
|
||||
(cons (list (cons 'file relpath)
|
||||
(cons 'message (exn-message e)))
|
||||
errors)))])
|
||||
(define sample-rate (inspect-flac-proc path))
|
||||
(define signature (file-signature path ini fingerprint-proc))
|
||||
(cond [(same-signature-state? old signature)
|
||||
(info-alm "unchanged fingerprint: ~a" relpath)
|
||||
(state-set-file! ks relpath (state-info path signature 'unchanged sample-rate '()))
|
||||
(values (summary-inc summary2 'unchanged) errors)]
|
||||
[(> sample-rate (ini-ref/int ini 'manager 'max-sample-rate 48000))
|
||||
(if (ini-ref/bool ini 'manager 'dry-run #f)
|
||||
(begin
|
||||
(warn-alm "dry-run: would convert ~a from ~a Hz to ~a Hz" relpath sample-rate (ini-ref/int ini 'manager 'max-sample-rate 48000))
|
||||
(state-set-file! ks relpath
|
||||
(state-info path signature 'dry-run sample-rate '()))
|
||||
(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))
|
||||
(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 '()))
|
||||
(values (summary-inc summary2 'ok) errors)]))]))
|
||||
|
||||
(define (drop-removed! ks current-relpaths summary)
|
||||
(define current (for/hash ([r (in-list current-relpaths)]) (values r #t)))
|
||||
(for/fold ([s summary]) ([old-rel (in-list (state-known-relpaths ks))])
|
||||
(if (hash-ref current old-rel #f)
|
||||
s
|
||||
(begin
|
||||
(info-alm "removed from state: ~a" old-rel)
|
||||
(state-drop-file! ks old-rel)
|
||||
(summary-inc s 'removed)))))
|
||||
|
||||
(define (manage-flac-tree base-directory
|
||||
#:inspect-flac-proc [inspect-flac-proc inspect-flac-sample-rate]
|
||||
#:fingerprint-proc [fingerprint-proc flac-taglib-fingerprint]
|
||||
#:convert-proc [convert-proc convert-flac-to-target-in-place])
|
||||
(define base-dir (filesystem-path base-directory))
|
||||
(unless (directory-exists? base-dir)
|
||||
(raise-argument-error 'manage-flac-tree "existing directory" base-directory))
|
||||
(define ini-file (manager-ini-file base-dir))
|
||||
(define state-file (manager-state-file base-dir))
|
||||
(define ini (load-manager-ini base-dir))
|
||||
(setup-logging! (ini-ref/path ini base-dir 'manager 'log-file ".flac-48khz-manager.log")
|
||||
(ini-ref/bool ini 'manager 'display-log #t))
|
||||
(info-alm "base directory: ~a" base-dir)
|
||||
(info-alm "state file: ~a" state-file)
|
||||
(info-alm "ini file: ~a" ini-file)
|
||||
(info-alm "change detection: ~a" (ini-ref/string ini 'manager 'change-detection "flac-taglib"))
|
||||
(define ks (open-manager-state state-file))
|
||||
(define files (find-flac-files base-dir))
|
||||
(define relpaths (map (lambda (p) (relpath-string base-dir p)) files))
|
||||
(define summary0 (drop-removed! ks relpaths (make-empty-summary)))
|
||||
(define-values (summary errors)
|
||||
(for/fold ([summary summary0] [errors '()]) ([p (in-list files)] [rel (in-list relpaths)])
|
||||
(process-one-file ks ini p rel inspect-flac-proc fingerprint-proc convert-proc summary errors)))
|
||||
(define errors* (reverse errors))
|
||||
(with-handlers ([exn:fail? (lambda (e) (err-alm "mail report failed: ~a" (exn-message e)) (void))])
|
||||
(maybe-send-report-mail ini summary errors*))
|
||||
(for ([line (in-list (summary->lines summary))]) (info-alm "summary: ~a" line))
|
||||
summary)
|
||||
|
||||
(module+ main
|
||||
(define base-dir #f)
|
||||
(command-line
|
||||
#:program "flac-48khz-manager.rkt"
|
||||
#:args (base-directory)
|
||||
(set! base-dir base-directory))
|
||||
(define summary (manage-flac-tree base-dir))
|
||||
(for ([line (in-list (summary->lines summary))])
|
||||
(displayln line)))
|
||||
@@ -1,229 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/cmdline
|
||||
racket/file
|
||||
racket/list
|
||||
racket/path
|
||||
"private/manager-ini.rkt"
|
||||
"private/flac2opus-state.rkt"
|
||||
"private/fingerprint.rkt"
|
||||
"private/hash.rkt"
|
||||
"private/log.rkt"
|
||||
"private/mail.rkt"
|
||||
"private/opus-convert.rkt"
|
||||
"private/report.rkt"
|
||||
"private/util.rkt")
|
||||
|
||||
(provide manage-flac2opus-tree
|
||||
summary->lines)
|
||||
|
||||
(define manager-admin-relpaths '(".music-info.db" ".flac-48khz-manager.ini" ".flac2opus-manager.log"))
|
||||
|
||||
(define (quick-file-info path)
|
||||
(list (cons 'size (file-size path))
|
||||
(cons 'mtime (file-or-directory-modify-seconds path))))
|
||||
|
||||
(define (manager-admin-relpath? relpath)
|
||||
(member relpath manager-admin-relpaths))
|
||||
|
||||
(define (source-file-signature path ini)
|
||||
(define mode (string-downcase (ini-ref/string ini 'manager 'change-detection "flac-taglib")))
|
||||
(define hash-algorithm (string-downcase (ini-ref/string ini 'manager 'hash-algorithm "sha256")))
|
||||
(cond [(member mode '("hash" "sha256" "full-hash" "full-sha256"))
|
||||
(string-append "file:" hash-algorithm ":" (file-digest path hash-algorithm))]
|
||||
[(flac-path? path)
|
||||
(cond [(member mode '("flac" "flac-streaminfo"))
|
||||
(string-append "flac-streaminfo:" (flac-streaminfo-fingerprint path))]
|
||||
[(or (member mode '("flac-taglib" "taglib+flac" "taglib-flac")) (not mode))
|
||||
(string-append "flac-taglib:" (flac-taglib-fingerprint path))]
|
||||
[else (format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))])]
|
||||
[else (format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))]))
|
||||
|
||||
(define (state-target-relpath old)
|
||||
(define v (and old (alist-ref/default old 'target-relpath #f)))
|
||||
(and v (normalize-relpath-string v)))
|
||||
|
||||
(define (same-quick-state? old path target-path target-relpath kbps)
|
||||
(and old
|
||||
(file-exists? target-path)
|
||||
(equal? (alist-ref/default old 'size #f) (file-size path))
|
||||
(equal? (alist-ref/default old 'mtime #f) (file-or-directory-modify-seconds path))
|
||||
(equal? (state-target-relpath old) target-relpath)
|
||||
(equal? (alist-ref/default old 'kbps #f) kbps)
|
||||
(not (equal? (alist-ref/default old 'status #f) 'error))))
|
||||
|
||||
(define (same-signature-state? old signature target-path target-relpath kbps)
|
||||
(and old
|
||||
(file-exists? target-path)
|
||||
(equal? (alist-ref/default old 'signature #f) signature)
|
||||
(equal? (state-target-relpath old) target-relpath)
|
||||
(equal? (alist-ref/default old 'kbps #f) kbps)
|
||||
(not (equal? (alist-ref/default old 'status #f) 'error))))
|
||||
|
||||
(define (source-relpath-string base-dir path)
|
||||
(normalized-relpath-string base-dir path))
|
||||
|
||||
(define (flac-extension-relpath? relpath)
|
||||
(let-values ([(base name dir?) (split-path (string->path relpath))])
|
||||
(and (path? name)
|
||||
(let ([ext (path-get-extension name)])
|
||||
(and ext (string-ci=? (bytes->string/utf-8 ext) ".flac"))))))
|
||||
|
||||
(define (target-relpath-for relpath)
|
||||
(if (flac-extension-relpath? relpath)
|
||||
(normalize-relpath-string
|
||||
(path->string (replace-path-extension (string->path relpath) #".opus")))
|
||||
relpath))
|
||||
|
||||
(define (target-path-for target-dir target-relpath)
|
||||
(build-path target-dir (normalized-relpath->path target-relpath)))
|
||||
|
||||
(define (delete-file/quiet path)
|
||||
(with-handlers ([exn:fail? (lambda (_) #f)])
|
||||
(and (file-exists? path) (delete-file path) #t)))
|
||||
|
||||
(define (delete-old-target-if-needed! target-dir old new-target-relpath)
|
||||
(define old-target-relpath (state-target-relpath old))
|
||||
(when (and old-target-relpath (not (equal? old-target-relpath new-target-relpath)))
|
||||
(define old-target (target-path-for target-dir old-target-relpath))
|
||||
(when (delete-file/quiet old-target)
|
||||
(info-alm "removed obsolete target: ~a" old-target-relpath))))
|
||||
|
||||
(define (copy-file/preserve-mtime! source target)
|
||||
(ensure-parent-directory! target)
|
||||
(copy-file source target #t)
|
||||
(file-or-directory-modify-seconds target (file-or-directory-modify-seconds source))
|
||||
(void))
|
||||
|
||||
(define (state-info source target-relpath signature status kbps extra)
|
||||
(append (quick-file-info source)
|
||||
(list (cons 'signature signature)
|
||||
(cons 'status status)
|
||||
(cons 'target-relpath target-relpath)
|
||||
(cons 'kbps kbps))
|
||||
extra))
|
||||
|
||||
(define (process-one-source-file ks ini target-dir path relpath target-relpath kbps convert-proc summary errors)
|
||||
(define target-path (target-path-for target-dir target-relpath))
|
||||
(define old (flac2opus-state-get-file ks relpath #f))
|
||||
(cond [(same-quick-state? old path target-path target-relpath kbps)
|
||||
(info-alm "unchanged: ~a" relpath)
|
||||
(values (summary-inc (summary-inc summary 'seen) 'unchanged) errors)]
|
||||
[else
|
||||
(define summary1 (summary-inc (summary-inc summary 'seen) 'processed))
|
||||
(define summary2 (if old (summary-inc summary1 'changed) (summary-inc summary1 'new)))
|
||||
(with-handlers ([exn:fail?
|
||||
(lambda (e)
|
||||
(err-alm "error for ~a: ~a" relpath (exn-message e))
|
||||
(flac2opus-state-set-file! ks relpath
|
||||
(append (quick-file-info path)
|
||||
(list (cons 'status 'error)
|
||||
(cons 'target-relpath target-relpath)
|
||||
(cons 'kbps kbps)
|
||||
(cons 'message (exn-message e)))))
|
||||
(values (summary-inc summary2 'errors)
|
||||
(cons (list (cons 'file relpath)
|
||||
(cons 'message (exn-message e)))
|
||||
errors)))])
|
||||
(define signature (source-file-signature path ini))
|
||||
(cond [(same-signature-state? old signature target-path target-relpath kbps)
|
||||
(info-alm "unchanged fingerprint: ~a" relpath)
|
||||
(flac2opus-state-set-file! ks relpath
|
||||
(state-info path target-relpath signature 'unchanged kbps '()))
|
||||
(values (summary-inc summary2 'unchanged) errors)]
|
||||
[(ini-ref/bool ini 'manager 'dry-run #f)
|
||||
(warn-alm "dry-run: would mirror ~a -> ~a" relpath target-relpath)
|
||||
(flac2opus-state-set-file! ks relpath
|
||||
(state-info path target-relpath signature 'dry-run kbps '()))
|
||||
(values (summary-inc (summary-inc summary2 'skipped) 'dry-run) errors)]
|
||||
[(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)
|
||||
(convert-proc path target-path kbps)
|
||||
(flac2opus-state-set-file! ks relpath
|
||||
(state-info path target-relpath signature 'converted kbps '()))
|
||||
(values (summary-inc summary2 'converted) errors)]
|
||||
[else
|
||||
(info-alm "copying ~a -> ~a" relpath target-relpath)
|
||||
(delete-old-target-if-needed! target-dir old target-relpath)
|
||||
(copy-file/preserve-mtime! path target-path)
|
||||
(flac2opus-state-set-file! ks relpath
|
||||
(state-info path target-relpath signature 'copied kbps '()))
|
||||
(values (summary-inc summary2 'copied) errors)]))]))
|
||||
|
||||
(define (drop-removed! ks target-dir current-relpaths summary)
|
||||
(define current (for/hash ([r (in-list current-relpaths)]) (values r #t)))
|
||||
(for/fold ([s summary]) ([old-rel (in-list (flac2opus-state-known-relpaths ks))])
|
||||
(if (hash-ref current old-rel #f)
|
||||
s
|
||||
(let* ([old (flac2opus-state-get-file ks old-rel #f)]
|
||||
[target-relpath (state-target-relpath old)])
|
||||
(when target-relpath
|
||||
(define target-path (target-path-for target-dir target-relpath))
|
||||
(when (delete-file/quiet target-path)
|
||||
(info-alm "removed target for deleted source: ~a" target-relpath)))
|
||||
(info-alm "removed from flac2opus state: ~a" old-rel)
|
||||
(flac2opus-state-drop-file! ks old-rel)
|
||||
(summary-inc s 'removed)))))
|
||||
|
||||
(define (find-source-files source-dir)
|
||||
(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
|
||||
#:kbps [kbps 224]
|
||||
#:convert-proc [convert-proc convert-flac-to-opus])
|
||||
(unless (and (integer? kbps) (positive? kbps))
|
||||
(raise-argument-error 'manage-flac2opus-tree "positive integer kbps" kbps))
|
||||
(define source-dir (filesystem-path source-directory))
|
||||
(define target-dir (filesystem-path target-directory))
|
||||
(unless (directory-exists? source-dir)
|
||||
(raise-argument-error 'manage-flac2opus-tree "existing source directory" source-directory))
|
||||
(make-directory* target-dir)
|
||||
(define ini-file (manager-ini-file source-dir))
|
||||
(define state-file (manager-state-file source-dir))
|
||||
(define ini (load-manager-ini source-dir))
|
||||
(setup-logging! (ini-ref/path ini source-dir 'opus-manager 'log-file ".flac2opus-manager.log")
|
||||
(ini-ref/bool ini 'manager 'display-log #t))
|
||||
(info-alm "flac2opus source directory: ~a" source-dir)
|
||||
(info-alm "flac2opus target directory: ~a" target-dir)
|
||||
(info-alm "state file: ~a" state-file)
|
||||
(info-alm "ini file: ~a" ini-file)
|
||||
(info-alm "change detection: ~a" (ini-ref/string ini 'manager 'change-detection "flac-taglib"))
|
||||
(info-alm "opus bitrate: ~a kbps" kbps)
|
||||
(define ks (open-flac2opus-state state-file))
|
||||
(define files (find-source-files source-dir))
|
||||
(define relpaths (map (lambda (p) (source-relpath-string source-dir p)) files))
|
||||
(define target-relpaths (map target-relpath-for relpaths))
|
||||
(define summary0 (drop-removed! ks target-dir relpaths (make-empty-summary)))
|
||||
(define-values (summary errors)
|
||||
(for/fold ([summary summary0] [errors '()]) ([p (in-list files)]
|
||||
[relpath (in-list relpaths)]
|
||||
[target-relpath (in-list target-relpaths)])
|
||||
(process-one-source-file ks ini target-dir p relpath target-relpath kbps convert-proc summary errors)))
|
||||
(define errors* (reverse errors))
|
||||
(with-handlers ([exn:fail? (lambda (e) (err-alm "mail report failed: ~a" (exn-message e)) (void))])
|
||||
(maybe-send-report-mail ini summary errors*
|
||||
#:manager-name "FLAC to Opus manager"
|
||||
#:result-label "converted/copied"))
|
||||
(for ([line (in-list (summary->lines summary))]) (info-alm "summary: ~a" line))
|
||||
summary)
|
||||
|
||||
(module+ main
|
||||
(define kbps 224)
|
||||
(define source-dir #f)
|
||||
(define target-dir #f)
|
||||
(command-line
|
||||
#:program "flac2opus-manager.rkt"
|
||||
#:once-each
|
||||
[("--kbps") k "Opus bitrate in kbps; default 224"
|
||||
(define n (string->number k))
|
||||
(unless (and (integer? n) (positive? n))
|
||||
(raise-argument-error 'flac2opus-manager "positive integer kbps" k))
|
||||
(set! kbps n)]
|
||||
#:args (source-directory target-directory)
|
||||
(set! source-dir source-directory)
|
||||
(set! target-dir target-directory))
|
||||
(define summary (manage-flac2opus-tree source-dir target-dir #:kbps kbps))
|
||||
(for ([line (in-list (summary->lines summary))])
|
||||
(displayln line)))
|
||||
@@ -1,8 +1,7 @@
|
||||
#lang racket/base
|
||||
|
||||
(require "flac-48khz-manager.rkt"
|
||||
"flac2opus-manager.rkt")
|
||||
(require "audio-manager.rkt"
|
||||
)
|
||||
|
||||
(provide manage-flac-tree
|
||||
manage-flac2opus-tree
|
||||
summary->lines)
|
||||
(provide audio-manager
|
||||
)
|
||||
|
||||
@@ -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?))
|
||||
@@ -1,82 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require rackunit
|
||||
racket/file
|
||||
racket/path
|
||||
"../flac-48khz-manager.rkt"
|
||||
"../private/fingerprint.rkt")
|
||||
|
||||
(define tmp (make-temporary-file "alm-test-~a" 'directory))
|
||||
(define hi (build-path tmp "hires.flac"))
|
||||
(define cd (build-path tmp "cd.flac"))
|
||||
(call-with-output-file hi #:exists 'replace (lambda (out) (display "hires" out)))
|
||||
(call-with-output-file cd #:exists 'replace (lambda (out) (display "cd" out)))
|
||||
|
||||
(define (u64be-bytes n)
|
||||
(define b (make-bytes 8 0))
|
||||
(for ([i (in-range 8)])
|
||||
(bytes-set! b i (bitwise-and (arithmetic-shift n (- (* 8 (- 7 i)))) #xff)))
|
||||
b)
|
||||
|
||||
(define (minimal-flac-bytes sample-rate)
|
||||
(define streaminfo (make-bytes 34 0))
|
||||
(bytes-set! streaminfo 0 #x10)
|
||||
(bytes-set! streaminfo 1 #x00)
|
||||
(bytes-set! streaminfo 2 #x10)
|
||||
(bytes-set! streaminfo 3 #x00)
|
||||
(define packed (bitwise-ior (arithmetic-shift sample-rate 44)
|
||||
(arithmetic-shift 1 41)
|
||||
(arithmetic-shift 15 36)
|
||||
1000))
|
||||
(bytes-copy! streaminfo 10 (u64be-bytes packed))
|
||||
(bytes-append #"fLaC" (bytes #x80 #x00 #x00 #x22) streaminfo))
|
||||
|
||||
(define native-flac (build-path tmp "native.flac"))
|
||||
(define id3-flac (build-path tmp "id3-prefix.flac"))
|
||||
(call-with-output-file native-flac #:exists 'replace
|
||||
(lambda (out) (write-bytes (minimal-flac-bytes 96000) out)))
|
||||
(call-with-output-file id3-flac #:exists 'replace
|
||||
(lambda (out)
|
||||
(write-bytes (bytes-append #"ID3" (bytes 4 0 0 0 0 0 3) #"abc" (minimal-flac-bytes 88200)) out)))
|
||||
(check-equal? (flac-streaminfo-sample-rate (read-flac-streaminfo native-flac)) 96000)
|
||||
(check-equal? (flac-streaminfo-sample-rate (read-flac-streaminfo id3-flac)) 88200)
|
||||
(delete-file native-flac)
|
||||
(delete-file id3-flac)
|
||||
|
||||
(define convert-count 0)
|
||||
|
||||
(define (mock-inspect p)
|
||||
(define s (file->string p))
|
||||
(cond [(regexp-match? #rx"converted" s) 48000]
|
||||
[(regexp-match? #rx"hires" s) 96000]
|
||||
[else 44100]))
|
||||
|
||||
(define (mock-fingerprint p)
|
||||
(string-append "mock:" (file->string p)))
|
||||
|
||||
(define (mock-convert p rate compression)
|
||||
(set! convert-count (add1 convert-count))
|
||||
(call-with-output-file p #:exists 'replace
|
||||
(lambda (out) (fprintf out "converted to ~a compression ~a" rate compression)))
|
||||
(lambda () rate))
|
||||
|
||||
(define first-summary
|
||||
(manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert))
|
||||
(check-equal? (assoc 'seen first-summary) '(seen . 2))
|
||||
(check-equal? (assoc 'new first-summary) '(new . 2))
|
||||
(check-equal? (assoc 'converted first-summary) '(converted . 1))
|
||||
(check-equal? convert-count 1)
|
||||
|
||||
(define second-summary
|
||||
(manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert))
|
||||
(check-equal? (assoc 'seen second-summary) '(seen . 2))
|
||||
(check-equal? (assoc 'unchanged second-summary) '(unchanged . 2))
|
||||
(check-equal? convert-count 1)
|
||||
|
||||
(delete-file cd)
|
||||
(define third-summary
|
||||
(manage-flac-tree tmp #:inspect-flac-proc mock-inspect #:fingerprint-proc mock-fingerprint #:convert-proc mock-convert))
|
||||
(check-equal? (assoc 'removed third-summary) '(removed . 1))
|
||||
(check-equal? (assoc 'unchanged third-summary) '(unchanged . 1))
|
||||
|
||||
(delete-directory/files tmp)
|
||||
@@ -1,61 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require rackunit
|
||||
racket/file
|
||||
racket/path
|
||||
"../flac2opus-manager.rkt")
|
||||
|
||||
(define tmp (make-temporary-file "alm-flac2opus-src-~a" 'directory))
|
||||
(define out (make-temporary-file "alm-flac2opus-out-~a" 'directory))
|
||||
(define sub (build-path tmp "disc1"))
|
||||
(make-directory* sub)
|
||||
|
||||
(call-with-output-file (build-path tmp ".flac-48khz-manager.ini") #:exists 'replace
|
||||
(lambda (o)
|
||||
(display "[manager]\n" o)
|
||||
(display "change-detection=quick\n" o)
|
||||
(display "display-log=false\n" o)
|
||||
(display "dry-run=false\n" o)
|
||||
(display "log-file=.flac-48khz-manager.log\n" o)
|
||||
(display "[mail]\n" o)
|
||||
(display "enabled=false\n" o)))
|
||||
|
||||
(define flac (build-path sub "track.flac"))
|
||||
(define pdf (build-path sub "booklet.pdf"))
|
||||
(define jpg (build-path tmp "cover.jpg"))
|
||||
(call-with-output-file flac #:exists 'replace (lambda (o) (display "fake flac" o)))
|
||||
(call-with-output-file pdf #:exists 'replace (lambda (o) (display "booklet" o)))
|
||||
(call-with-output-file jpg #:exists 'replace (lambda (o) (display "jpg" o)))
|
||||
|
||||
(define convert-count 0)
|
||||
(define (mock-convert src dst kbps)
|
||||
(set! convert-count (add1 convert-count))
|
||||
(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)))
|
||||
(lambda () kbps))
|
||||
|
||||
(define first-summary
|
||||
(manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))
|
||||
(check-equal? (assoc 'seen first-summary) '(seen . 3))
|
||||
(check-equal? (assoc 'converted first-summary) '(converted . 1))
|
||||
(check-equal? (assoc 'copied first-summary) '(copied . 2))
|
||||
(check-true (file-exists? (build-path out "disc1" "track.opus")))
|
||||
(check-true (file-exists? (build-path out "disc1" "booklet.pdf")))
|
||||
(check-true (file-exists? (build-path out "cover.jpg")))
|
||||
(check-equal? convert-count 1)
|
||||
|
||||
(define second-summary
|
||||
(manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))
|
||||
(check-equal? (assoc 'seen second-summary) '(seen . 3))
|
||||
(check-equal? (assoc 'unchanged second-summary) '(unchanged . 3))
|
||||
(check-equal? convert-count 1)
|
||||
|
||||
(delete-file pdf)
|
||||
(define third-summary
|
||||
(manage-flac2opus-tree tmp out #:kbps 192 #:convert-proc mock-convert))
|
||||
(check-equal? (assoc 'removed third-summary) '(removed . 1))
|
||||
(check-false (file-exists? (build-path out "disc1" "booklet.pdf")))
|
||||
|
||||
(delete-directory/files tmp)
|
||||
(delete-directory/files out)
|
||||
@@ -1,45 +0,0 @@
|
||||
#lang racket/base
|
||||
|
||||
(require rackunit
|
||||
racket/file
|
||||
keystore
|
||||
"../private/flac2opus-state.rkt"
|
||||
"../private/state.rkt"
|
||||
"../private/util.rkt")
|
||||
|
||||
(check-equal? (normalize-relpath-string "disc1\\track.flac") "disc1/track.flac")
|
||||
(check-equal? (legacy-backslash-relpath-string "disc1/track.flac") "disc1\\track.flac")
|
||||
(check-exn exn:fail:contract? (lambda () (normalize-relpath-string "../track.flac")))
|
||||
(check-exn exn:fail:contract? (lambda () (normalize-relpath-string "/music/track.flac")))
|
||||
(check-exn exn:fail:contract? (lambda () (normalize-relpath-string "C:/music/track.flac")))
|
||||
|
||||
(define state-file (make-temporary-file "alm-state-~a.db"))
|
||||
(define ks (open-manager-state state-file))
|
||||
(void (state-set-file! ks "disc1\\track.flac" '((status . normalized))))
|
||||
(check-equal? (state-get-file ks "disc1/track.flac") '((status . normalized)))
|
||||
(check-equal? (state-known-relpaths ks) '("disc1/track.flac"))
|
||||
(check-not-false (member "flac-48khz:file:disc1/track.flac" (ks-keys-glob ks "flac-48khz:file:*")))
|
||||
(check-false (member "flac-48khz:file:disc1\\track.flac" (ks-keys-glob ks "flac-48khz:file:*")))
|
||||
|
||||
(define legacy-48-key (string-append "flac-48khz:file:" (legacy-backslash-relpath-string "legacy/track.flac")))
|
||||
(void (ks-set! ks legacy-48-key '((status . legacy))))
|
||||
(check-equal? (state-get-file ks "legacy/track.flac") '((status . legacy)))
|
||||
(void (state-set-file! ks "legacy/track.flac" '((status . migrated))))
|
||||
(check-equal? (state-get-file ks "legacy/track.flac") '((status . migrated)))
|
||||
(check-false (member legacy-48-key (ks-keys-glob ks "flac-48khz:file:*")))
|
||||
|
||||
(define ks2 (open-flac2opus-state state-file))
|
||||
(void (flac2opus-state-set-file! ks2 "disc1\\track.flac" '((target-relpath . "disc1/track.opus"))))
|
||||
(check-equal? (flac2opus-state-get-file ks2 "disc1/track.flac") '((target-relpath . "disc1/track.opus")))
|
||||
(check-equal? (flac2opus-state-known-relpaths ks2) '("disc1/track.flac"))
|
||||
(check-not-false (member "flac2opus:file:disc1/track.flac" (ks-keys-glob ks2 "flac2opus:file:*")))
|
||||
(check-false (member "flac2opus:file:disc1\\track.flac" (ks-keys-glob ks2 "flac2opus:file:*")))
|
||||
|
||||
(define legacy-opus-key (string-append "flac2opus:file:" (legacy-backslash-relpath-string "legacy/track.flac")))
|
||||
(void (ks-set! ks2 legacy-opus-key '((target-relpath . "legacy\\track.opus"))))
|
||||
(check-equal? (flac2opus-state-get-file ks2 "legacy/track.flac") '((target-relpath . "legacy\\track.opus")))
|
||||
(void (flac2opus-state-set-file! ks2 "legacy/track.flac" '((target-relpath . "legacy/track.opus"))))
|
||||
(check-equal? (flac2opus-state-get-file ks2 "legacy/track.flac") '((target-relpath . "legacy/track.opus")))
|
||||
(check-false (member legacy-opus-key (ks-keys-glob ks2 "flac2opus:file:*")))
|
||||
|
||||
(delete-file state-file)
|
||||
Reference in New Issue
Block a user