nog een

2026-06-10 08:45:11 +02:00
parent 930903fb42
commit 3b61e358dc
10 changed files with 190 additions and 63 deletions
@@ -0,0 +1,43 @@
+#lang racket/base
+
+(require racket/file
+         racket/path
+         "util.rkt")
+
+(provide convert-flac-to-target-in-place)
+
+(define (temp-output-path input-path)
+  (define-values (base name dir?) (split-path input-path))
+  (define name-str (path->string name))
+  (build-path base (format ".~a.tmp-~a.flac" name-str (current-inexact-milliseconds))))
+
+(define (delete-file/quiet! p)
+  (with-handlers ([exn:fail? (lambda (_) (void))])
+    (when (file-exists? p) (delete-file p))))
+
+(define (settings max-sample-rate compression-level)
+  (make-immutable-hash
+   (list (cons 'target-sample-rate max-sample-rate)
+         (cons 'compression-level compression-level))))
+
+(define (call-audio-encode audio-encode in-file out-file settings progress-callback)
+  (if progress-callback
+      (audio-encode in-file out-file settings
+                    #:encoder 'flac
+                    #:copy-tags? #t
+                    #:progress-callback progress-callback)
+      (audio-encode in-file out-file settings
+                    #:encoder 'flac
+                    #:copy-tags? #t)))
+
+(define (convert-flac-to-target-in-place input-path max-sample-rate compression-level
+                                         #:progress-callback [progress-callback #f])
+  (define tmp-path (temp-output-path input-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 audio-encode (dynamic-require 'racket-audio/audio-encoder 'audio-encode))
+    (define result (call-audio-encode audio-encode input-path tmp-path
+                                      (settings max-sample-rate compression-level)
+                                      progress-callback))
+    (rename-file-or-directory tmp-path input-path #t)
+    result))
@@ -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))
@@ -7,34 +7,11 @@
 (provide find-flac-files
         find-regular-files)

-(define (directory-list/quiet dir)
-  (with-handlers ([exn:fail? (lambda (_) '())])
-    (directory-list dir #:build? #t)))
-
-(define (directory-exists?/quiet p)
-  (with-handlers ([exn:fail? (lambda (_) #f)])
-    (directory-exists? p)))
-
-(define (file-exists?/quiet p)
-  (with-handlers ([exn:fail? (lambda (_) #f)])
-    (file-exists? p)))
-
 (define (sort-paths paths)
  (sort paths string<? #:key path->string))

 (define (find-regular-files base-dir)
-  ;; Do not use racket/file:find-files here.  On Windows UNC trees, especially
-  ;; with long paths, fold-files can raise "path disappeared" for a single
-  ;; entry and abort the whole scan.  This walker treats entries that disappear,
-  ;; are inaccessible, or cannot be represented by the platform path layer as a
-  ;; skipped entry and continues the scan.
-  (define root (filesystem-path base-dir))
-  (let loop ([dir root] [acc '()])
-    (for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))])
-      (cond [(directory-exists?/quiet p) (loop p acc)]
-            [(file-exists?/quiet p) (cons p acc)]
-            [else acc]))))
+  (sort-paths (directory-file-paths base-dir)))

 (define (find-flac-files base-dir)
-  (sort-paths (filter (lambda (p) (and (flac-path? p) (not (manager-temp-path? p))))
-                      (find-regular-files base-dir))))
+  (filter flac-path? (find-regular-files base-dir)))
@@ -113,22 +113,17 @@
 (define (file-exists?/quiet p)
  (with-handlers ([exn:fail? (lambda (_) #f)]) (file-exists? p)))

-(define (path-file-name-string p)
-  (let-values ([(base name dir?) (split-path p)])
-    (and (path? name) (path->string name))))
-
-(define (manager-temp-path? p)
-  (define name (path-file-name-string p))
-  (and name
-       (string-prefix? name ".")
-       (regexp-match? #rx"\\.tmp-[0-9.]+\\.(flac|opus)$" name)))
-
 (define (flac-path? p)
  (and (file-exists?/quiet p) (extension-ci=? p ".flac")))

 (define (opus-path? p)
  (and (file-exists?/quiet p) (extension-ci=? p ".opus")))

+(define (manager-temp-path? p)
+  (define-values (_base name _dir?) (split-path p))
+  (and (path? name)
+       (regexp-match? #rx"^\\..*\\.tmp-[0-9.]+\\.(flac|opus)$" (path->string name))))
+
 (define (regular-file-path? p)
  (file-exists?/quiet p))

@@ -150,7 +145,7 @@
  (let loop ([dir root] [acc '()])
    (for/fold ([acc acc]) ([p (in-list (sort-paths (directory-list/quiet dir)))])
      (cond [(directory-exists?/quiet p) (loop p acc)]
-            [(file-exists?/quiet p) (cons p acc)]
+            [(and (file-exists?/quiet p) (not (manager-temp-path? p))) (cons p acc)]
            [else acc]))))

 (define (replace-path-extension p ext)