Prevent reading directorysizes so much

cl-xdg-trash/directorysizes.lisp

@@ -91,30 +91,66 @@ 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")))
+        (dir (gensym "DIR"))
+        (rval (gensym "RVAL")))
     `(let* ((,target-path (ensure-nonwild-pathname ,path))
-            (,dir (parent-directory ,target-path)))
+            (,dir (parent-directory ,target-path))
+            ,rval)
        (uiop:call-with-temporary-file
         #'(lambda (,stream ,tmp-path)
-            ,@body
+            (setq ,rval (progn ,@body))
             (osicat-posix:rename
              (uiop:native-namestring ,tmp-path)
              (uiop:native-namestring ,target-path)))
-        :keep t :directory ,dir :type nil))))
+        :keep t :directory ,dir :type nil)
+       ,rval)))
 
+(declaim (ftype (function ((or string pathname) &key (:default t)) t)
+                read-directorysizes-for-trash-directory))
+(defun read-directorysizes-for-trash-directory
+    (trash-directory &key (default (make-hash-table :test #'equal)))
+  "Read the directorysizes file in TRASH-DIRECTORY. If the operation fails,
+return DEFAULT (which defaults to an empty directorysizes table)."
+  (let ((path (calculate-directorysizes-path trash-directory)))
+    (handler-case
+        (read-directorysizes-file path)
+      (error () default))))
 
-(declaim (ftype (function ((or string pathname) string) (or integer null))
+(declaim (ftype (function ((or string pathname) hash-table &optional t)
+                          boolean)
+                write-directorysizes-for-trash-directory))
+(defun write-directorysizes-for-trash-directory
+    (trash-directory directorysizes &optional no-error)
+  "Update the directorysizes file of TRASH-DIRECTORY with DIRECTORYSIZES. With
+NO-ERROR, This will return t if the operation succeeded and nil otherwise."
+  (handler-bind
+      ((error (lambda (e)
+                (if no-error
+                    (return-from write-directorysizes-for-trash-directory)
+                    (signal e)))))
+    (with-atomic-write
+        (stream (calculate-directorysizes-path trash-directory))
+      (format-directorysizes stream directorysizes)
+      t)))
+
+(declaim (ftype (function ((or string pathname) string &key
+                                                (:directorysizes hash-table)
+                                                (:no-write t))
+                          (or integer null))
                 update-directorysizes-entry))
-(defun trashed-file-size (trash-directory name)
+(defun trashed-file-size
+    (trash-directory name
+     &key
+       (directorysizes (read-directorysizes-for-trash-directory
+                        trash-directory))
+       no-write)
   "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. As a second value,
-return whether the cache actually needed updating."
+return whether the cache actually needed updating. This can be inhibited by
-  (let* ((directorysizes-path (calculate-directorysizes-path trash-directory))
+setting NO-WRITE to a non-nil value. Optionally, you can pass a pre-read
-         (directorysizes (handler-case
+directorysizes object to DIRECTORYSIZES (note that this object will be
-                             (read-directorysizes-file directorysizes-path)
+destructively updated, even with NO-WRITE)."
-                           (file-error ()
+  (let* ((cur-entry (gethash name directorysizes))
-                             (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
@@ -148,10 +184,7 @@ return whether the cache actually needed updating."
                 :name name)
                did-change t
                ret-size size))))
-    (when did-change
+    (when (and (not no-write) did-change)
-      (handler-case
+      (write-directorysizes-for-trash-directory
-          (with-atomic-write (stream directorysizes-path)
+       trash-directory directorysizes t))
-            (format-directorysizes stream directorysizes))
-        ;; ignore errors when updating the cache
-        (osicat-posix:posix-error ())))
     (values ret-size did-change)))

cl-xdg-trash/package.lisp

@@ -66,6 +66,8 @@
                 #:directory-as-file-pathname)
   (:export #:read-directorysizes-file
            #:prase-directorysizes
+           #:read-directorysizes-for-trash-directory
+           #:write-directorysizes-for-trash-directory
            #:trashed-file-size
            #:calculate-directorysizes-path))
 

cl-xdg-trash/url-encode.lisp

@@ -76,10 +76,10 @@ represent."
                 escape-char-for-url))
 (defun escape-char-for-url (char &key safe-chars)
   "Escape CHAR such that it is safe to include in a URL."
-  (if (or (url-unreserved-character-p char) (member char safe-chars
+  (if (or (url-unreserved-character-p char)
-                                                    :test #'eql))
+          (member char safe-chars :test #'eql))
       (list char)
-      (coerce (format nil "~{%~X~}" (utf-8-encode-char char)) 'list)))
+      (coerce (format nil "~{%~2,'0X~}" (utf-8-encode-char char)) 'list)))
 
 (declaim (ftype (function (string &key (:start integer) (:end integer)
                                   (:safe-chars list))

clash/clash.lisp

@@ -11,6 +11,9 @@
   (:import-from #:cl-xdg-trash/mountpoints
                 #:file-or-dir-namestring
                 #:ensure-nonwild-pathname)
+  (:import-from #:cl-xdg-trash/directorysizes
+                #:read-directorysizes-for-trash-directory
+                #:write-directorysizes-for-trash-directory)
   (:use #:cl #:clash/parse-date #:clash/format)
   (:export #:toplevel))
 
@@ -1036,4 +1039,5 @@ Args can be supplied to facilitate testing in SLIME."
                                          *toplevel/help-option*)))
     (if argsp
         (clingon:run (toplevel/command) args)
-        (clingon:run (toplevel/command)))))
+        (clingon:run (toplevel/command)))
+    (flush-directorysizes-cache)))

clash/format.lisp

@@ -3,6 +3,8 @@
   (:import-from #:cl-xdg-trash/mountpoints
                 #:file-or-dir-namestring)
   (:import-from #:cl-xdg-trash/directorysizes
+                #:read-directorysizes-for-trash-directory
+                #:write-directorysizes-for-trash-directory
                 #:trashed-file-size)
   (:import-from #:cl-xdg-trash/trashinfo
                 #:trashinfo-trash-directory
@@ -13,6 +15,7 @@
                 #:trashinfo-trashed-file)
   (:use #:cl)
   (:export #:trashinfo-size
+           #:flush-directorysizes-cache
            #:format-size
            #:parse-format-string
            #:option-format-string
@@ -28,6 +31,19 @@
 
 (in-package :clash/format)
 
+(defvar *directorysizes-cache* (make-hash-table :test #'equal)
+  "Cache for directorysizes tables (trash-directory -> (need-flush . table)).")
+
+(defun get-directorysizes-for-trashinfo (trashinfo)
+  "Return a directorysizes table for the trash-directory of TRASHINFO."
+  (let* ((trash-directory (trashinfo-trash-directory trashinfo))
+         (cur-val (gethash trash-directory *directorysizes-cache*)))
+    (if (hash-table-p cur-val)
+        cur-val
+        (setf (gethash trash-directory *directorysizes-cache*)
+              (cons nil
+                    (read-directorysizes-for-trash-directory trash-directory))))))
+
 (defvar *trashinfo-size-cache* (make-hash-table :test #'eq)
   "Cache for trashinfo sizes.")
 
@@ -35,11 +51,26 @@
   "Return the size of TRASHINFO and cache it."
   (let ((res (gethash trashinfo *trashinfo-size-cache* :none)))
     (if (eq res :none)
-        (setf (gethash trashinfo *trashinfo-size-cache*)
+        (let ((directorysizes-pair (get-directorysizes-for-trashinfo trashinfo)))
-              (trashed-file-size (trashinfo-trash-directory trashinfo)
+          (multiple-value-bind (size did-change)
-                                 (trashinfo-name trashinfo)))
+              (trashed-file-size
+               (trashinfo-trash-directory trashinfo)
+               (trashinfo-name trashinfo)
+               :directorysizes (cdr directorysizes-pair)
+               :no-write t)
+            (when did-change
+              (setf (car directorysizes-pair) t))
+            (setf (gethash trashinfo *trashinfo-size-cache*) size)))
         res)))
 
+(defun flush-directorysizes-cache ()
+  "Flush the cached directorysizes changes."
+  (maphash (lambda (trash-directory directorysizes-pair)
+             (when (car directorysizes-pair)
+               (write-directorysizes-for-trash-directory
+                trash-directory (cdr directorysizes-pair) t)))
+           *directorysizes-cache*))
+
 (defun format-size (count &optional base-two (places 2))
   "Pretty print COUNT, which is a number of bytes. This will append metric
 suffixes as necessary. If BASE-TWO is non-nil, use MiB, GiB, etc. suffixes