117 lines
4.8 KiB
Racket
117 lines
4.8 KiB
Racket
#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))
|