168 lines
8.6 KiB
Racket
168 lines
8.6 KiB
Racket
#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)))
|