156 lines
6.7 KiB
Common Lisp
156 lines
6.7 KiB
Common Lisp
(in-package :cl-xdg-trash/directorysizes)
|
|
|
|
(declaim (ftype (function ((or string pathname)) integer) regular-file-size))
|
|
(defun regular-file-size (path)
|
|
"Return the size (in bytes) of the non-directory file PATH."
|
|
(let ((res (osicat-posix:stat (uiop:native-namestring
|
|
(ensure-nonwild-pathname path)))))
|
|
(when (osicat-posix:s-isdir (osicat-posix:stat-mode res))
|
|
(error 'file-error :pathname path))
|
|
(osicat-posix:stat-size res)))
|
|
|
|
(declaim (ftype (function ((or string pathname)) integer) file-size))
|
|
(defun file-size (path)
|
|
"Return the size of the file (inode) named by PATH."
|
|
(loop for queue = (list (ensure-nonwild-pathname path)) then queue
|
|
while queue
|
|
for cur = (first queue)
|
|
for res = (osicat-posix:stat cur)
|
|
do (pop queue)
|
|
when (osicat-posix:s-isdir (osicat-posix:stat-mode res))
|
|
do (setq queue (nconc (uiop:directory*
|
|
(merge-pathnames
|
|
uiop:*wild-file-for-directory* cur))
|
|
queue))
|
|
else
|
|
summing (regular-file-size cur)))
|
|
|
|
(declaim (ftype (function (string character &optional (or null integer)) list)
|
|
split-string))
|
|
(defun split-string (string seperator &optional max)
|
|
"Split STRING on SEPERATOR, a character. If MAX is an integer, return a list
|
|
of at most MAX elements, with the last element being the remaining, un-split
|
|
part of STRING."
|
|
(loop with start = 0
|
|
with count = 0
|
|
for i below (length string)
|
|
while (or (not (integerp max)) (< count (1- max)))
|
|
for char = (aref string i)
|
|
when (eql char seperator)
|
|
collect (subseq string start i) into out
|
|
and do (setq start (1+ i)
|
|
count (1+ count))
|
|
finally (return (progn
|
|
(nconc out (list (subseq string start)))))))
|
|
|
|
(defstruct directorysizes-entry
|
|
"Single entry in a directorysizes file."
|
|
size mtime name)
|
|
|
|
(declaim (ftype (function (stream) hash-table) parse-directorysizes))
|
|
(defun parse-directorysizes (stream)
|
|
"Parse the directorysizes file read from STREAM."
|
|
(loop with out = (make-hash-table :test #'equal)
|
|
for line = (read-line stream nil)
|
|
while line
|
|
for (size mtime encoded-name) = (split-string line #\Space 3)
|
|
for name = (url-decode encoded-name)
|
|
do (setf (gethash name out)
|
|
(make-directorysizes-entry
|
|
:size (parse-integer size)
|
|
:mtime (parse-integer mtime)
|
|
:name name))
|
|
finally (return out)))
|
|
|
|
(declaim (ftype (function ((or string pathname)) hash-table)
|
|
read-directorysizes-file))
|
|
(defun read-directorysizes-file (path)
|
|
"Read the directorysizes file PATH."
|
|
(with-open-file (stream (ensure-nonwild-pathname path))
|
|
(parse-directorysizes stream)))
|
|
|
|
(declaim (ftype (function ((or string pathname)) pathname)
|
|
calculate-direcotrysizes-path))
|
|
(defun calculate-direcotrysizes-path (trash-directory)
|
|
"Return the directorysizes file for TRASH-DIRECTORY."
|
|
(merge-pathnames #P"directorysizes"
|
|
(ensure-nonwild-pathname trash-directory
|
|
:ensure-directory t)))
|
|
|
|
(declaim (ftype (function ((or boolean stream) hash-table) t)
|
|
format-directorysizes))
|
|
(defun format-directorysizes (stream directorysizes)
|
|
"Write DIRECTORYSIZES to STREAM."
|
|
(loop for name being the hash-keys of directorysizes
|
|
using (hash-value entry)
|
|
do (with-slots (size mtime) entry
|
|
(format stream "~A ~A ~A~%" size mtime (url-encode name)))))
|
|
|
|
(defmacro with-atomic-write ((stream path) &body body)
|
|
"Evaluate BODY with STREAM bound to a stream that will write to a temporary
|
|
file. If execution is successful, rename this temporary file to PATH, replacing
|
|
it."
|
|
(let ((tmp-path (gensym "TMP-PATH-"))
|
|
(target-path (gensym "TARGET-PATH-"))
|
|
(dir (gensym "DIR")))
|
|
`(let* ((,target-path (ensure-nonwild-pathname ,path))
|
|
(,dir (uiop:pathname-parent-directory-pathname ,target-path)))
|
|
(uiop:call-with-temporary-file
|
|
#'(lambda (,stream ,tmp-path)
|
|
,@body
|
|
(osicat-posix:rename
|
|
(uiop:native-namestring ,tmp-path)
|
|
(uiop:native-namestring ,target-path)))
|
|
:keep t :directory ,dir :type nil))))
|
|
|
|
|
|
(declaim (ftype (function ((or string pathname) string))
|
|
update-directorysizes-entry))
|
|
(defun trashed-file-size (trash-directory name)
|
|
"Return the size of the trashed file NAME in TRASH-DIRECTORY. If NAME is a
|
|
directory and the file size cache is out of date, update it."
|
|
(let* ((directorysizes-path (calculate-direcotrysizes-path trash-directory))
|
|
(directorysizes (handler-case
|
|
(read-directorysizes-file directorysizes-path)
|
|
(file-error ()
|
|
(make-hash-table :test #'equal))))
|
|
(cur-entry (gethash name directorysizes))
|
|
(path (merge-pathnames (make-pathname :name name
|
|
:directory '(:relative "files"))
|
|
(ensure-nonwild-pathname trash-directory
|
|
:ensure-directory t)))
|
|
(stat (handler-case
|
|
(osicat-posix:stat (uiop:native-namestring path))
|
|
(t nil nil)))
|
|
(trashinfo-mtime
|
|
(handler-case (osicat-posix:stat-mtime
|
|
(osicat-posix:stat (uiop:native-namestring
|
|
(compute-trashinfo-source-file
|
|
trash-directory name))))
|
|
(t nil nil)))
|
|
did-change ret-size)
|
|
(cond
|
|
((not stat)
|
|
(setf did-change (remhash name directorysizes)))
|
|
((not (osicat-posix:s-isdir (osicat-posix:stat-mode stat)))
|
|
(setf did-change (remhash name directorysizes)
|
|
ret-size (osicat-posix:stat-size stat)))
|
|
((and (directorysizes-entry-p cur-entry)
|
|
(eql (directorysizes-entry-mtime cur-entry)
|
|
trashinfo-mtime))
|
|
(setq ret-size (directorysizes-entry-size cur-entry)))
|
|
(t
|
|
(let ((orig-size (gethash name directorysizes))
|
|
(size (file-size path)))
|
|
(setf (gethash name directorysizes)
|
|
(make-directorysizes-entry
|
|
:mtime trashinfo-mtime
|
|
:size size
|
|
:name name)
|
|
did-change (not (eql size orig-size))
|
|
ret-size size))))
|
|
(when did-change
|
|
(with-atomic-write (stream directorysizes-path)
|
|
(format-directorysizes stream directorysizes)))
|
|
ret-size))
|