opus conversie

2026-06-09 08:41:01 +02:00
parent 92c8e40518
commit ce5c4d6de5
18 changed files with 1202 additions and 86 deletions
@@ -0,0 +1,111 @@
+#lang racket/base
+
+(require racket/file
+         racket/list
+         racket/path
+         racket/place
+         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 (convert-flac-to-opus input-path output-path kbps)
+  (define tmp-path (temp-output-path output-path))
+  (ensure-parent-directory! tmp-path)
+  (define worker
+    (place ch
+      (define msg (place-channel-get ch))
+      (define in-file (list-ref msg 0))
+      (define out-file (list-ref msg 1))
+      (define kbps (list-ref msg 2))
+      (with-handlers ([exn:fail? (lambda (e) (place-channel-put ch (list 'error (exn-message e))))])
+        (define-values (settings properties picture) (source-tags->settings in-file kbps))
+        (define audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
+        (define result (audio-encode in-file out-file settings #:encoder 'opus #:copy-tags? #f))
+        (copy-all-tag-properties! out-file properties picture)
+        (place-channel-put ch (list 'ok result)))))
+  (place-channel-put worker (list (path->string input-path) (path->string tmp-path) kbps))
+  (define response (place-channel-get worker))
+  (cond [(and (pair? response) (eq? (car response) 'ok))
+         (ensure-parent-directory! output-path)
+         (rename-file-or-directory tmp-path output-path #t)
+         (cadr response)]
+        [else
+         (when (file-exists? tmp-path) (delete-file tmp-path))
+         (error 'convert-flac-to-opus "conversion failed for ~a: ~a" input-path
+                (if (and (pair? response) (pair? (cdr response))) (cadr response) response))]))