Genormaliseerde paden in keystore.

private/flac2opus-state.rkt

@@ -1,6 +1,8 @@
 #lang racket/base
 
-(require keystore)
+(require racket/list
+         keystore
+         "util.rkt")
 
 (provide open-flac2opus-state
          flac2opus-state-get-file
@@ -14,17 +16,39 @@
   (ks-open state-file))
 
 (define (file-state-key relpath)
-  (string-append prefix relpath))
+  (string-append prefix (normalize-relpath-string relpath)))
+
+(define (legacy-file-state-key relpath)
+  (string-append prefix (legacy-backslash-relpath-string relpath)))
+
+(define (ks-drop/quiet! ks key)
+  (with-handlers ([exn:fail? (lambda (_) (void))])
+    (ks-drop! ks key)))
 
 (define (flac2opus-state-get-file ks relpath [default #f])
-  (ks-get ks (file-state-key relpath) default))
+  (define key (file-state-key relpath))
+  (define legacy-key (legacy-file-state-key relpath))
+  (define missing (gensym 'missing))
+  (define value (ks-get ks key missing))
+  (cond [(not (eq? value missing)) value]
+        [(equal? key legacy-key) default]
+        [else (ks-get ks legacy-key default)]))
 
 (define (flac2opus-state-set-file! ks relpath value)
-  (ks-set! ks (file-state-key relpath) value))
+  (define key (file-state-key relpath))
+  (define legacy-key (legacy-file-state-key relpath))
+  (ks-set! ks key value)
+  (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
 
 (define (flac2opus-state-drop-file! ks relpath)
-  (ks-drop! ks (file-state-key relpath)))
+  (define key (file-state-key relpath))
+  (define legacy-key (legacy-file-state-key relpath))
+  (ks-drop/quiet! ks key)
+  (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
 
 (define (flac2opus-state-known-relpaths ks)
-  (map (lambda (k) (substring k (string-length prefix)))
-       (ks-keys-glob ks (string-append prefix "*"))))
+  (remove-duplicates
+   (map (lambda (k)
+          (normalize-relpath-string (substring k (string-length prefix))))
+        (ks-keys-glob ks (string-append prefix "*")))
+   equal?))

private/state.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 
-(require racket/string
-         keystore)
+(require racket/list
+         keystore
+         "util.rkt")
 
 (provide open-manager-state
          file-state-key
@@ -16,18 +17,39 @@
   (ks-open state-file))
 
 (define (file-state-key relpath)
-  (string-append prefix relpath))
+  (string-append prefix (normalize-relpath-string relpath)))
+
+(define (legacy-file-state-key relpath)
+  (string-append prefix (legacy-backslash-relpath-string relpath)))
+
+(define (ks-drop/quiet! ks key)
+  (with-handlers ([exn:fail? (lambda (_) (void))])
+    (ks-drop! ks key)))
 
 (define (state-get-file ks relpath [default #f])
-  (ks-get ks (file-state-key relpath) default))
+  (define key (file-state-key relpath))
+  (define legacy-key (legacy-file-state-key relpath))
+  (define missing (gensym 'missing))
+  (define value (ks-get ks key missing))
+  (cond [(not (eq? value missing)) value]
+        [(equal? key legacy-key) default]
+        [else (ks-get ks legacy-key default)]))
 
 (define (state-set-file! ks relpath value)
-  (ks-set! ks (file-state-key relpath) value))
+  (define key (file-state-key relpath))
+  (define legacy-key (legacy-file-state-key relpath))
+  (ks-set! ks key value)
+  (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
 
 (define (state-drop-file! ks relpath)
-  (ks-drop! ks (file-state-key relpath)))
+  (define key (file-state-key relpath))
+  (define legacy-key (legacy-file-state-key relpath))
+  (ks-drop/quiet! ks key)
+  (unless (equal? key legacy-key) (ks-drop/quiet! ks legacy-key)))
 
 (define (state-known-relpaths ks)
-  (map (lambda (k)
-         (substring k (string-length prefix)))
-       (ks-keys-glob ks (string-append prefix "*"))))
+  (remove-duplicates
+   (map (lambda (k)
+          (normalize-relpath-string (substring k (string-length prefix))))
+        (ks-keys-glob ks (string-append prefix "*")))
+   equal?))

private/util.rkt

@@ -9,6 +9,10 @@
          int-value
          string-value
          split-addresses
+         normalized-relpath-string
+         normalized-relpath->path
+         normalize-relpath-string
+         legacy-backslash-relpath-string
          relpath-string
          filesystem-path
          flac-path?
@@ -70,8 +74,34 @@
                   [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 (filesystem-path base) (filesystem-path p))))
+(define (replace-char s from to)
+  (list->string
+   (for/list ([ch (in-string s)])
+     (if (char=? ch from) to ch))))
+
+(define (normalize-relpath-string s)
+  (define normalized (replace-char s #\\ #\/))
+  (when (or (string=? normalized "")
+            (regexp-match? #rx"^[A-Za-z]:" normalized)
+            (regexp-match? #rx"^/" normalized)
+            (regexp-match? #rx"(^|/)\\.\\.(/|$)" normalized))
+    (raise-argument-error 'normalize-relpath-string "relative path without .." s))
+  normalized)
+
+(define (legacy-backslash-relpath-string relpath)
+  (replace-char (normalize-relpath-string relpath) #\/ #\\))
+
+(define (normalized-relpath-string base p)
+  (normalize-relpath-string
+   (path->string (find-relative-path (filesystem-path base) (filesystem-path p)))))
+
+(define relpath-string normalized-relpath-string)
+
+(define (normalized-relpath->path relpath)
+  (define parts (regexp-split #rx"/+" (normalize-relpath-string relpath)))
+  (when (ormap (lambda (part) (or (string=? part "") (string=? part "."))) parts)
+    (raise-argument-error 'normalized-relpath->path "relative normalized path" relpath))
+  (apply build-path parts))
 
 (define (extension-ci=? p ext)
   (let-values ([(base name dir?) (split-path p)])