From b023d98fe99c1b75bdc9d76c49ff0c48308012c6 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Sun, 1 Feb 2026 02:08:16 -0800 Subject: [PATCH] Prevent reading directorysizes so much --- cl-xdg-trash/directorysizes.lisp | 71 +++++++++++++++++++++++--------- cl-xdg-trash/package.lisp | 2 + cl-xdg-trash/url-encode.lisp | 6 +-- clash/clash.lisp | 6 ++- clash/format.lisp | 37 +++++++++++++++-- 5 files changed, 96 insertions(+), 26 deletions(-) diff --git a/cl-xdg-trash/directorysizes.lisp b/cl-xdg-trash/directorysizes.lisp index 7fcc02b..dd241c8 100644 --- a/cl-xdg-trash/directorysizes.lisp +++ b/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." - (let* ((directorysizes-path (calculate-directorysizes-path trash-directory)) - (directorysizes (handler-case - (read-directorysizes-file directorysizes-path) - (file-error () - (make-hash-table :test #'equal)))) - (cur-entry (gethash name directorysizes)) +return whether the cache actually needed updating. This can be inhibited by +setting NO-WRITE to a non-nil value. Optionally, you can pass a pre-read +directorysizes object to DIRECTORYSIZES (note that this object will be +destructively updated, even with NO-WRITE)." + (let* ((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 - (handler-case - (with-atomic-write (stream directorysizes-path) - (format-directorysizes stream directorysizes)) - ;; ignore errors when updating the cache - (osicat-posix:posix-error ()))) + (when (and (not no-write) did-change) + (write-directorysizes-for-trash-directory + trash-directory directorysizes t)) (values ret-size did-change))) diff --git a/cl-xdg-trash/package.lisp b/cl-xdg-trash/package.lisp index fb7d4c3..2ff71f1 100644 --- a/cl-xdg-trash/package.lisp +++ b/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)) diff --git a/cl-xdg-trash/url-encode.lisp b/cl-xdg-trash/url-encode.lisp index b6dd048..4636508 100644 --- a/cl-xdg-trash/url-encode.lisp +++ b/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 - :test #'eql)) + (if (or (url-unreserved-character-p char) + (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)) diff --git a/clash/clash.lisp b/clash/clash.lisp index be1b84a..807a291 100644 --- a/clash/clash.lisp +++ b/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))) diff --git a/clash/format.lisp b/clash/format.lisp index 7d32329..a311335 100644 --- a/clash/format.lisp +++ b/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*) - (trashed-file-size (trashinfo-trash-directory trashinfo) - (trashinfo-name trashinfo))) + (let ((directorysizes-pair (get-directorysizes-for-trashinfo trashinfo))) + (multiple-value-bind (size did-change) + (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