hans/audio-library-manager
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Genormaliseerde paden in keystore.

Browse Source
This commit is contained in:
Hans Dijkema
2026-06-09 15:25:27 +02:00
parent ce5c4d6de5
commit 5263ebee71
7 changed files with 170 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files
flac2opus-manager.rkt
+25 -27
View File
@@ -39,12 +39,16 @@
[else (format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))])]
[else (format "mtime-size:~a:~a" (file-size path) (file-or-directory-modify-seconds path))]))
(define (state-target-relpath old)
(define v (and old (alist-ref/default old 'target-relpath #f)))
(and v (normalize-relpath-string v)))
(define (same-quick-state? old path target-path target-relpath kbps)
(and old
(file-exists? target-path)
(equal? (alist-ref/default old 'size #f) (file-size path))
(equal? (alist-ref/default old 'mtime #f) (file-or-directory-modify-seconds path))
(equal? (alist-ref/default old 'target-relpath #f) target-relpath)
(equal? (state-target-relpath old) target-relpath)
(equal? (alist-ref/default old 'kbps #f) kbps)
(not (equal? (alist-ref/default old 'status #f) 'error))))
@@ -52,36 +56,36 @@
(and old
(file-exists? target-path)
(equal? (alist-ref/default old 'signature #f) signature)
(equal? (alist-ref/default old 'target-relpath #f) target-relpath)
(equal? (state-target-relpath old) target-relpath)
(equal? (alist-ref/default old 'kbps #f) kbps)
(not (equal? (alist-ref/default old 'status #f) 'error))))
(define (source-relpath base-dir path)
(find-relative-path (filesystem-path base-dir) (filesystem-path path)))
(define (source-relpath-string base-dir path)
(path->string (source-relpath base-dir path)))
(normalized-relpath-string base-dir path))
(define (flac-extension-path? p)
(let-values ([(base name dir?) (split-path p)])
(define (flac-extension-relpath? relpath)
(let-values ([(base name dir?) (split-path (string->path relpath))])
(and (path? name)
(let ([ext (path-get-extension name)])
(and ext (string-ci=? (bytes->string/utf-8 ext) ".flac"))))))
(define (target-relpath-for rel)
(if (flac-extension-path? rel) (replace-path-extension rel #".opus") rel))
(define (target-relpath-for relpath)
(if (flac-extension-relpath? relpath)
(normalize-relpath-string
(path->string (replace-path-extension (string->path relpath) #".opus")))
relpath))
(define (target-path-for target-dir target-rel)
(build-path target-dir target-rel))
(define (target-path-for target-dir target-relpath)
(build-path target-dir (normalized-relpath->path target-relpath)))
(define (delete-file/quiet path)
(with-handlers ([exn:fail? (lambda (_) #f)])
(and (file-exists? path) (delete-file path) #t)))
(define (delete-old-target-if-needed! target-dir old new-target-relpath)
(define old-target-relpath (and old (alist-ref/default old 'target-relpath #f)))
(define old-target-relpath (state-target-relpath old))
(when (and old-target-relpath (not (equal? old-target-relpath new-target-relpath)))
(define old-target (build-path target-dir old-target-relpath))
(define old-target (target-path-for target-dir old-target-relpath))
(when (delete-file/quiet old-target)
(info-alm "removed obsolete target: ~a" old-target-relpath))))
@@ -99,9 +103,8 @@
(cons 'kbps kbps))
extra))
(define (process-one-source-file ks config source-dir target-dir path rel relpath target-rel target-relpath
kbps convert-proc summary errors)
(define target-path (target-path-for target-dir target-rel))
(define (process-one-source-file ks config target-dir path relpath target-relpath kbps convert-proc summary errors)
(define target-path (target-path-for target-dir target-relpath))
(define old (flac2opus-state-get-file ks relpath #f))
(cond [(same-quick-state? old path target-path target-relpath kbps)
(info-alm "unchanged: ~a" relpath)
@@ -155,9 +158,9 @@
(if (hash-ref current old-rel #f)
s
(let* ([old (flac2opus-state-get-file ks old-rel #f)]
[target-relpath (and old (alist-ref/default old 'target-relpath #f))])
[target-relpath (state-target-relpath old)])
(when target-relpath
(define target-path (build-path target-dir target-relpath))
(define target-path (target-path-for target-dir target-relpath))
(when (delete-file/quiet target-path)
(info-alm "removed target for deleted source: ~a" target-relpath)))
(info-alm "removed from flac2opus state: ~a" old-rel)
@@ -188,19 +191,14 @@
(info-alm "opus bitrate: ~a kbps" kbps)
(define ks (open-flac2opus-state (manager-config-state-file config)))
(define files (find-source-files source-dir))
(define rels (map (lambda (p) (source-relpath source-dir p)) files))
(define relpaths (map path->string rels))
(define target-rels (map target-relpath-for rels))
(define target-relpaths (map path->string target-rels))
(define relpaths (map (lambda (p) (source-relpath-string source-dir p)) files))
(define target-relpaths (map target-relpath-for relpaths))
(define summary0 (drop-removed! ks target-dir relpaths (make-empty-summary)))
(define-values (summary errors)
(for/fold ([summary summary0] [errors '()]) ([p (in-list files)]
[rel (in-list rels)]
[relpath (in-list relpaths)]
[target-rel (in-list target-rels)]
[target-relpath (in-list target-relpaths)])
(process-one-source-file ks config source-dir target-dir p rel relpath target-rel target-relpath
kbps convert-proc summary errors)))
(process-one-source-file ks config target-dir p relpath target-relpath kbps convert-proc summary errors)))
(define errors* (reverse errors))
(with-handlers ([exn:fail? (lambda (e) (err-alm "mail report failed: ~a" (exn-message e)) (void))])
(maybe-send-report-mail config summary errors*