Zander671/cl-xdg-trash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Prevent reading directorysizes so much

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-02-01 02:08:16 -08:00
parent d205dde599
commit b023d98fe9
5 changed files with 96 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
cl-xdg-trash/directorysizes.lisp
View File

@ -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)))

2
cl-xdg-trash/package.lisp
View File

@ -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))

6
cl-xdg-trash/url-encode.lisp
View File

@ -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))

6
clash/clash.lisp
View File

@ -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)))

37
clash/format.lisp
View File

@ -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