Full conversion done
This commit is contained in:
+42
-153
@@ -1,165 +1,54 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/file
|
||||
racket/list
|
||||
(require racket/date
|
||||
racket/format
|
||||
racket/path
|
||||
racket/string)
|
||||
racket/string
|
||||
)
|
||||
|
||||
(provide bool-value
|
||||
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?
|
||||
opus-path?
|
||||
manager-temp-path?
|
||||
directory-file-paths
|
||||
replace-path-extension
|
||||
ensure-parent-directory!
|
||||
alist-ref/default
|
||||
alist-set)
|
||||
(provide date->yyyy-mm-dd
|
||||
now
|
||||
get-cover-file
|
||||
basename
|
||||
basedir
|
||||
not-hidden?
|
||||
)
|
||||
|
||||
(define (bool-value v [default #f])
|
||||
(cond [(boolean? v) v]
|
||||
[(number? v) (not (zero? v))]
|
||||
[(string? v)
|
||||
(define s (string-downcase (string-trim v)))
|
||||
(cond [(member s '("#t" "true" "yes" "y" "1" "on")) #t]
|
||||
[(member s '("#f" "false" "no" "n" "0" "off" "")) #f]
|
||||
[else default])]
|
||||
[else default]))
|
||||
(define (now)
|
||||
(seconds->date (current-seconds)))
|
||||
|
||||
(define (int-value v [default 0])
|
||||
(cond [(integer? v) v]
|
||||
[(number? v) (inexact->exact (round v))]
|
||||
[(string? v) (or (string->number (string-trim v)) default)]
|
||||
[else default]))
|
||||
(define (date->yyyy-mm-dd d)
|
||||
(format "~a-~a-~a"
|
||||
(date-year d)
|
||||
(~r (date-month d) #:min-width 2 #:pad-string "0")
|
||||
(~r (date-day d) #:min-width 2 #:pad-string "0")))
|
||||
|
||||
(define (string-value v [default ""])
|
||||
(cond [(string? v) v]
|
||||
[(symbol? v) (symbol->string v)]
|
||||
[(number? v) (number->string v)]
|
||||
[(boolean? v) (if v "#t" "#f")]
|
||||
[(not v) default]
|
||||
[else (format "~a" v)]))
|
||||
(define (get-cover-file path)
|
||||
(let-values (((base name dir) (split-path path)))
|
||||
(let ((names '((jpg "cover.jpg") (jpg "cover.jpeg")
|
||||
(jpg "folder.jpg") (jpg "folder.jpeg")
|
||||
(png "cover.png") (png "folder.png"))))
|
||||
(letrec ((f (λ (l)
|
||||
(if (null? l)
|
||||
(values #f #f)
|
||||
(if (file-exists? (build-path base (cadar l)))
|
||||
(values (caar l) (build-path base (cadar l)))
|
||||
(f (cdr l)))))))
|
||||
(f names)))))
|
||||
|
||||
(define (split-addresses v)
|
||||
(define s (string-value v ""))
|
||||
(filter (lambda (x) (not (string=? x "")))
|
||||
(map string-trim (regexp-split #px"[,;]" s))))
|
||||
(define (basename path)
|
||||
(file-name-from-path path))
|
||||
|
||||
(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 (basedir path)
|
||||
(path-only path))
|
||||
|
||||
(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 (replace-char s from to)
|
||||
(list->string
|
||||
(for/list ([ch (in-string s)])
|
||||
(if (char=? ch from) to ch))))
|
||||
(define (hidden-path? p)
|
||||
(for/or ([part (in-list (explode-path p))])
|
||||
(and (path? part)
|
||||
(let ([s (path->string part)])
|
||||
(and (string-prefix? s ".")
|
||||
(not (member s '("." ".."))))))))
|
||||
|
||||
(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)])
|
||||
(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?/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))
|
||||
|
||||
(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)]
|
||||
[(and (file-exists?/quiet p) (not (manager-temp-path? 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))
|
||||
(when (path? base) (make-directory* base)))
|
||||
|
||||
(define (alist-ref/default a k [default #f])
|
||||
(define e (assoc k a))
|
||||
(if e (cdr e) default))
|
||||
|
||||
(define (alist-set a k v)
|
||||
(cons (cons k v) (filter (lambda (e) (not (equal? (car e) k))) a)))
|
||||
(define (not-hidden? path)
|
||||
(not (hidden-path? path)))
|
||||
|
||||
Reference in New Issue
Block a user