96 lines
3.8 KiB
Common Lisp
96 lines
3.8 KiB
Common Lisp
|
(in-package #:sync-music)
|
||
|
|
|
||
|
|
(defvar *worker-threads* nil
|
||
|
|
"Number of worker threads to launch.")
|
||
|
|
(defvar *opus-bitrate* "64K"
|
||
|
|
"Opus bitrate to pass to ffmpeg's -b:a flag.")
|
||
|
|
(defvar *max-depth* 8
|
||
|
|
"Max depth to recur into folders before signalling.")
|
||
|
|
(defvar *cleanupp* t
|
||
|
|
"Whether to perform remove actions and delete empty folders.")
|
||
|
|
(defvar *ignore-toplevel-p* t
|
||
|
|
"Whether to ignore files at the top level.")
|
||
|
|
|
||
|
|
(defparameter *general-extensions* '("mp3" "ogg" "opus")
|
||
|
|
"General file extensions that should be copied over.")
|
||
|
|
(defparameter *meta-extensions* '("cue" "m3u" "m3u8")
|
||
|
|
"File extensions where *.flac text needs to be replaced.")
|
||
|
|
|
||
|
|
(defun maybe-normalize-unicode (s)
|
||
|
|
(if (stringp s) (uax-15:normalize s :nfc) s))
|
||
|
|
|
||
|
|
(defun pathname-normalize-unicode (p)
|
||
|
|
"Normalize the unicode for all components of PATHNAME."
|
||
|
|
(make-pathname :directory (mapcar #'maybe-normalize-unicode
|
||
|
|
(pathname-directory p))
|
||
|
|
:name (maybe-normalize-unicode (pathname-name p))
|
||
|
|
:type (maybe-normalize-unicode (pathname-type p))
|
||
|
|
:defaults p))
|
||
|
|
|
||
|
|
(defun vector-nconc-extend (v1 v2 &key (start 0) end)
|
||
|
|
"Like vector-append-extend, but using another vector.
|
||
|
|
|
||
|
|
START and END are the same as in REPLACE for V2."
|
||
|
|
(let* ((fill-pointer (fill-pointer v1))
|
||
|
|
(new-fill-pointer (+ fill-pointer (- (or end (length v2)) start))))
|
||
|
|
(loop :for size := (array-total-size v1)
|
||
|
|
:while (< size new-fill-pointer)
|
||
|
|
:do (adjust-array v1 (+ size (max (floor size 2) 10))))
|
||
|
|
(setf (fill-pointer v1) new-fill-pointer)
|
||
|
|
(replace v1 v2 :start1 fill-pointer :start2 start :end2 end)))
|
||
|
|
|
||
|
|
(defun replace-all-subseqs (seq subseq1 subseq2)
|
||
|
|
"Replace all instances of SUBSEQ1 with SUBSEQ in SEQ.
|
||
|
|
|
||
|
|
Returns a new array if replacements were made and NIL otherwise."
|
||
|
|
(loop :with seqlen := (length seq)
|
||
|
|
:and sublen1 := (length subseq1)
|
||
|
|
:and sublen2 := (length subseq2)
|
||
|
|
:for prev-index := 0 :then (+ index sublen1)
|
||
|
|
:for index := (search subseq1 seq :start2 prev-index)
|
||
|
|
:while index
|
||
|
|
;; NOTE: Avoid WITH to not create an array on immediate returns
|
||
|
|
:for out-buf := (make-array (+ seqlen
|
||
|
|
(if (> sublen2 sublen1)
|
||
|
|
(max (floor seqlen 2) 10)
|
||
|
|
0))
|
||
|
|
:element-type (array-element-type seq)
|
||
|
|
:adjustable t
|
||
|
|
:fill-pointer 0)
|
||
|
|
:then out-buf
|
||
|
|
:do (vector-nconc-extend out-buf seq :start prev-index :end index)
|
||
|
|
(vector-nconc-extend out-buf subseq2)
|
||
|
|
:finally (when out-buf
|
||
|
|
(return
|
||
|
|
(vector-nconc-extend out-buf seq :start prev-index)))))
|
||
|
|
|
||
|
|
(defun replace-text-buffer (buf from to)
|
||
|
|
"Given octet array BUF, converts all instances of text FROM to TO.
|
||
|
|
|
||
|
|
Tries to take into account different character sizes."
|
||
|
|
(loop :repeat 3
|
||
|
|
:for from-buf := (babel:string-to-octets from :encoding :ascii)
|
||
|
|
:then (intersperse 0 from-buf)
|
||
|
|
:for to-buf := (babel:string-to-octets to :encoding :ascii)
|
||
|
|
:then (intersperse 0 to-buf)
|
||
|
|
:for replaced := (replace-all-subseqs buf from-buf to-buf)
|
||
|
|
:when replaced
|
||
|
|
:return replaced
|
||
|
|
:finally (return buf)))
|
||
|
|
|
||
|
|
(define-condition exceeded-max-depth (error)
|
||
|
|
()
|
||
|
|
(:report (lambda (c s)
|
||
|
|
(declare (ignore c))
|
||
|
|
(format s "exceeded the max directory depth"))))
|
||
|
|
|
||
|
|
(defun check-depth (depth)
|
||
|
|
(when (= depth *max-depth*)
|
||
|
|
(restart-case
|
||
|
|
(error 'exceeded-max-depth)
|
||
|
|
(ignore-max-depth ()
|
||
|
|
:report "Continue and ignore max depth for future checks."
|
||
|
|
(setf *max-depth* 0))
|
||
|
|
(ignore-once ()
|
||
|
|
:report "Ignore max depth this one time."))))
|