opus conversie

private/util.rkt

@@ -10,7 +10,11 @@
          string-value
          split-addresses
          relpath-string
+         filesystem-path
          flac-path?
+         opus-path?
+         directory-file-paths
+         replace-path-extension
          ensure-parent-directory!
          alist-ref/default
          alist-set)
@@ -44,14 +48,74 @@
   (filter (lambda (x) (not (string=? x "")))
           (map string-trim (regexp-split #px"[,;]" s))))
 
+(define (windows-extended-path-string s)
+  (cond [(or (< (string-length s) 3)
+             (not (eq? (system-type 'os) 'windows))
+             (string-prefix? s "\\\\?\\"))
+         s]
+        [(and (>= (string-length s) 2)
+              (char=? (string-ref s 0) #\\)
+              (char=? (string-ref s 1) #\\))
+         (string-append "\\\\?\\UNC\\" (substring s 2))]
+        [(and (>= (string-length s) 3)
+              (char-alphabetic? (string-ref s 0))
+              (char=? (string-ref s 1) #\:)
+              (char=? (string-ref s 2) #\\))
+         (string-append "\\\\?\\" s)]
+        [else s]))
+
+(define (filesystem-path p)
+  (define s (cond [(path? p) (path->string p)]
+                  [(string? p) p]
+                  [else (raise-argument-error 'filesystem-path "path-string? or path?" p)]))
+  (simple-form-path (string->path (windows-extended-path-string s))))
+
 (define (relpath-string base p)
-  (path->string (find-relative-path (simple-form-path base) (simple-form-path p))))
+  (path->string (find-relative-path (filesystem-path base) (filesystem-path p))))
+
+(define (extension-ci=? p ext)
+  (let-values ([(base name dir?) (split-path p)])
+    (and (path? name)
+         (let ([e (path-get-extension name)])
+           (and e (string-ci=? (bytes->string/utf-8 e) ext))))))
+
+(define (file-exists?/quiet p)
+  (with-handlers ([exn:fail? (lambda (_) #f)]) (file-exists? p)))
 
 (define (flac-path? p)
-  (and (file-exists? p)
-       (let-values ([(base name dir?) (split-path p)])
-         (and (path? name)
-              (string-ci=? (bytes->string/utf-8 (or (path-get-extension name) #"")) ".flac")))))
+  (and (file-exists?/quiet p) (extension-ci=? p ".flac")))
+
+(define (opus-path? p)
+  (and (file-exists?/quiet p) (extension-ci=? p ".opus")))
+
+(define (regular-file-path? p)
+  (file-exists?/quiet p))
+
+(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 (sort-paths paths)
+  (sort paths string<? #:key path->string))
+
+(define (directory-file-paths base-dir)
+  ;; Tolerant recursive walker for Windows UNC/long-path trees.  A single
+  ;; vanished or unreadable entry is skipped instead of aborting 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]))))
+
+(define (replace-path-extension p ext)
+  (let-values ([(base name dir?) (split-path p)])
+    (unless (path? name) (error 'replace-path-extension "path has no file name: ~a" p))
+    (build-path base (path-replace-extension name ext))))
 
 (define (ensure-parent-directory! p)
   (define-values (base name dir?) (split-path p))