nog een

private/opus-convert.rkt

@@ -0,0 +1,112 @@
+#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))