228 lines
11 KiB
Racket
228 lines
11 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/cmdline
|
|
racket/file
|
|
racket/list
|
|
racket/path
|
|
"private/config.rkt"
|
|
"private/flac2opus-state.rkt"
|
|
"private/fingerprint.rkt"
|
|
"private/hash.rkt"
|
|
"private/log.rkt"
|
|
"private/mail.rkt"
|
|
"private/opus-convert-place.rkt"
|
|
"private/report.rkt"
|
|
"private/util.rkt")
|
|
|
|
(provide manage-flac2opus-tree
|
|
summary->lines)
|
|
|
|
(define manager-admin-relpaths '(".music-info.db" ".flac-48khz-manager.ini" ".flac-48khz-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 config)
|
|
(define mode (manager-config-change-detection config))
|
|
(cond [(member mode '("hash" "sha256" "full-hash" "full-sha256"))
|
|
(string-append "file:" (manager-config-hash-algorithm config) ":"
|
|
(file-digest path (manager-config-hash-algorithm config)))]
|
|
[(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 config 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 config))
|
|
(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)]
|
|
[(manager-config-dry-run? config)
|
|
(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)
|
|
(define result (convert-proc path target-path kbps))
|
|
(flac2opus-state-set-file! ks relpath
|
|
(state-info path target-relpath signature 'converted kbps
|
|
(list (cons 'encoder-result result))))
|
|
(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 config (load-manager-config source-dir))
|
|
(setup-logging! (manager-config-log-file config) (manager-config-display-log? config))
|
|
(info-alm "flac2opus source directory: ~a" source-dir)
|
|
(info-alm "flac2opus target directory: ~a" target-dir)
|
|
(info-alm "state file: ~a" (manager-config-state-file config))
|
|
(info-alm "ini file: ~a" (manager-config-ini-file config))
|
|
(info-alm "change detection: ~a" (manager-config-change-detection config))
|
|
(info-alm "opus bitrate: ~a kbps" kbps)
|
|
(define ks (open-flac2opus-state (manager-config-state-file config)))
|
|
(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 config 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 config 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)))
|