127 lines
5.2 KiB
Common Lisp
127 lines
5.2 KiB
Common Lisp
(in-package #:sync-music)
|
|
|
|
(defvar *worker-threads* nil
|
|
"Number of worker threads to launch.")
|
|
(defvar *opus-bitrate* "96K"
|
|
"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.")
|
|
(defvar *dumb-cue-copy-p* nil
|
|
"Whether to blindly copy cue files rather than parse them.")
|
|
|
|
(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.")
|
|
|
|
(defparameter *timestamp-scanner* (ppcre:create-scanner "^(\\d+):(\\d{2})\\.(\\d{2})$")
|
|
"Scan for a cuetools position.")
|
|
|
|
(defparameter *invalid-char-scanner* (ppcre:create-scanner "[\"*/:<>?\\\\|]")
|
|
"Scan for any characters not allowed in an Android/NTFS file name.")
|
|
|
|
(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))
|
|
|
|
(defmacro handle-overflow ((unit unit-max) (next-unit &optional next-max) &rest args)
|
|
"Handle integer overflow from UNIT with maximum UNIT-MAX into NEXT-UNIT."
|
|
(with-gensyms (div rem)
|
|
`(when (>= ,unit ,unit-max)
|
|
(multiple-value-bind (,div ,rem)
|
|
(floor ,unit ,unit-max)
|
|
(setf ,unit ,rem)
|
|
(incf ,next-unit ,div))
|
|
,(when next-max
|
|
`(handle-overflow (,next-unit ,next-max) ,@args)))))
|
|
|
|
(defun convert-timestamp (s)
|
|
"Convert cuetools position MM:SS.FF to ffmpeg duration MM:SS.m."
|
|
(let* ((all-times (nth-value 1 (ppcre:scan-to-strings *timestamp-scanner* s)))
|
|
(hours 0)
|
|
(minutes (parse-integer (aref all-times 0)))
|
|
(seconds (parse-integer (aref all-times 1)))
|
|
(frames (parse-integer (aref all-times 2)))
|
|
(millis (round (* frames 1000) 75)))
|
|
(handle-overflow (millis 1000) (seconds 60) (minutes))
|
|
(handle-overflow (minutes 60) (hours))
|
|
(format nil "~D:~2,'0D:~2,'0D.~3,'0D" hours minutes seconds millis)))
|
|
|
|
(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."))))
|