Lots of work

directorysizes.lisp

@@ -0,0 +1,155 @@
+(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))