From 14bf3a1da1f7dee8d9243a098075c4e90a626826 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Fri, 26 Jun 2026 18:06:31 +0200 Subject: [PATCH] Cleanup of vibe code and replacement by self coded audio manager. --- audio-manager.rkt | 58 +++++--- flac-48khz-manager.rkt | 167 ---------------------- flac2opus-manager.rkt | 229 ------------------------------- main.rkt | 9 +- private/audio.rkt | 8 -- private/convert-place.rkt | 43 ------ private/convert.rkt | 43 ------ private/cover-art.rkt | 55 -------- private/file-walker.rkt | 6 +- private/fingerprint.rkt | 177 ------------------------ private/flac2opus-state.rkt | 54 -------- private/hash.rkt | 21 --- private/manager-ini.rkt | 77 ----------- private/opus-convert-place.rkt | 116 ---------------- private/opus-convert.rkt | 112 --------------- private/report.rkt | 57 -------- private/scan.rkt | 17 --- private/state.rkt | 55 -------- test/flac-48khz-manager-test.rkt | 82 ----------- test/flac2opus-manager-test.rkt | 61 -------- test/path-state-test.rkt | 45 ------ 21 files changed, 43 insertions(+), 1449 deletions(-) delete mode 100644 flac-48khz-manager.rkt delete mode 100644 flac2opus-manager.rkt delete mode 100644 private/audio.rkt delete mode 100644 private/convert-place.rkt delete mode 100644 private/convert.rkt delete mode 100644 private/cover-art.rkt delete mode 100644 private/fingerprint.rkt delete mode 100644 private/flac2opus-state.rkt delete mode 100644 private/hash.rkt delete mode 100644 private/manager-ini.rkt delete mode 100644 private/opus-convert-place.rkt delete mode 100644 private/opus-convert.rkt delete mode 100644 private/report.rkt delete mode 100644 private/scan.rkt delete mode 100644 private/state.rkt delete mode 100644 test/flac-48khz-manager-test.rkt delete mode 100644 test/flac2opus-manager-test.rkt delete mode 100644 test/path-state-test.rkt diff --git a/audio-manager.rkt b/audio-manager.rkt index b318a6f..36a86f0 100644 --- a/audio-manager.rkt +++ b/audio-manager.rkt @@ -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,17 +125,19 @@ (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) - (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)) - ) + (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)) + ) (values base-path path info)) (define (flac-khz-bits base-path path info) @@ -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) - (hash-set! info 'khz 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) diff --git a/flac-48khz-manager.rkt b/flac-48khz-manager.rkt deleted file mode 100644 index b16eaf0..0000000 --- a/flac-48khz-manager.rkt +++ /dev/null @@ -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))) diff --git a/flac2opus-manager.rkt b/flac2opus-manager.rkt deleted file mode 100644 index 1990e3d..0000000 --- a/flac2opus-manager.rkt +++ /dev/null @@ -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))) diff --git a/main.rkt b/main.rkt index 7f6f044..3144a03 100644 --- a/main.rkt +++ b/main.rkt @@ -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 + ) diff --git a/private/audio.rkt b/private/audio.rkt deleted file mode 100644 index 092b6a0..0000000 --- a/private/audio.rkt +++ /dev/null @@ -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))) diff --git a/private/convert-place.rkt b/private/convert-place.rkt deleted file mode 100644 index bb784df..0000000 --- a/private/convert-place.rkt +++ /dev/null @@ -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)) diff --git a/private/convert.rkt b/private/convert.rkt deleted file mode 100644 index adc69cb..0000000 --- a/private/convert.rkt +++ /dev/null @@ -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)) diff --git a/private/cover-art.rkt b/private/cover-art.rkt deleted file mode 100644 index 61b83d3..0000000 --- a/private/cover-art.rkt +++ /dev/null @@ -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)))) diff --git a/private/file-walker.rkt b/private/file-walker.rkt index 99dd475..4f4ce95 100644 --- a/private/file-walker.rkt +++ b/private/file-walker.rkt @@ -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)))) ) diff --git a/private/fingerprint.rkt b/private/fingerprint.rkt deleted file mode 100644 index 51bfa90..0000000 --- a/private/fingerprint.rkt +++ /dev/null @@ -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)) stringstring 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)) diff --git a/private/manager-ini.rkt b/private/manager-ini.rkt deleted file mode 100644 index e5ec5fb..0000000 --- a/private/manager-ini.rkt +++ /dev/null @@ -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))) diff --git a/private/opus-convert-place.rkt b/private/opus-convert-place.rkt deleted file mode 100644 index 5acd432..0000000 --- a/private/opus-convert-place.rkt +++ /dev/null @@ -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) stringsettings 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)) diff --git a/private/opus-convert.rkt b/private/opus-convert.rkt deleted file mode 100644 index cf47601..0000000 --- a/private/opus-convert.rkt +++ /dev/null @@ -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) stringsettings 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)) diff --git a/private/report.rkt b/private/report.rkt deleted file mode 100644 index fdd90c4..0000000 --- a/private/report.rkt +++ /dev/null @@ -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 "~a~a" - (html-escape k) (summary-ref summary k 0))))) - (define error-html - (if (null? errors) - "

No errors were reported.

" - (string-append - "

Errors

" - (apply string-append - (for/list ([e (in-list errors)]) - (format "" - (html-escape (alist-ref/default e 'file "")) - (html-escape (alist-ref/default e 'message ""))))) - "
FileError
~a
~a
"))) - (format "~a

~a

Summary

~a
~a" - (html-escape title) (html-escape title) rows error-html)) diff --git a/private/scan.rkt b/private/scan.rkt deleted file mode 100644 index 9d0c700..0000000 --- a/private/scan.rkt +++ /dev/null @@ -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 stringstring)) - -(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))) diff --git a/private/state.rkt b/private/state.rkt deleted file mode 100644 index ebeba18..0000000 --- a/private/state.rkt +++ /dev/null @@ -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?)) diff --git a/test/flac-48khz-manager-test.rkt b/test/flac-48khz-manager-test.rkt deleted file mode 100644 index 65949f9..0000000 --- a/test/flac-48khz-manager-test.rkt +++ /dev/null @@ -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) diff --git a/test/flac2opus-manager-test.rkt b/test/flac2opus-manager-test.rkt deleted file mode 100644 index 41647eb..0000000 --- a/test/flac2opus-manager-test.rkt +++ /dev/null @@ -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) diff --git a/test/path-state-test.rkt b/test/path-state-test.rkt deleted file mode 100644 index 769f75b..0000000 --- a/test/path-state-test.rkt +++ /dev/null @@ -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)