mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

Add extra checks before expiring the URL cache

Browse source 
(url-cache-prune-cache): Check that the directory exists before
trying to delete it.
This commit is contained in:
Lars Ingebrigtsen 2012-02-06 22:37:56 +01:00
parent 1968bb1b5c
commit 7dd679eb09
2 changed files with 22 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lisp/url/ChangeLog
View file

@ -1,6 +1,8 @@
2012-02-06 Lars Ingebrigtsen <larsi@gnus.org>
* url-cache.el (url-cache-prune-cache): New function.
(url-cache-prune-cache): Check that the directory exists before
trying to delete it.
* url.el (url-retrieve-number-of-calls): New variable.
(url-retrieve-internal): Use it to expire the cache once in a

38
lisp/url/url-cache.el
View file

@ -216,24 +216,26 @@ considered \"expired\"."
(let ((current-time (current-time))
(total-files 0)
(deleted-files 0))
(dolist (file (directory-files (or directory url-cache-directory) t))
(unless (member (file-name-nondirectory file) '("." ".."))
(setq total-files (1+ total-files))
(cond
((file-directory-p file)
(when (url-cache-prune-cache file)
(setq deleted-files (1+ deleted-files))))
((time-less-p
(time-add
(nth 5 (file-attributes file))
(seconds-to-time url-cache-expire-time))
current-time)
(delete-file file)
(setq deleted-files (1+ deleted-files))))))
(if (< deleted-files total-files)
nil
(delete-directory directory)
t)))
(setq directory (or directory url-cache-directory))
(when (file-exists-p directory)
(dolist (file (directory-files directory t))
(unless (member (file-name-nondirectory file) '("." ".."))
(setq total-files (1+ total-files))
(cond
((file-directory-p file)
(when (url-cache-prune-cache file)
(setq deleted-files (1+ deleted-files))))
((time-less-p
(time-add
(nth 5 (file-attributes file))
(seconds-to-time url-cache-expire-time))
current-time)
(delete-file file)
(setq deleted-files (1+ deleted-files))))))
(if (< deleted-files total-files)
nil
(delete-directory directory)
t))))
(provide 'url-cache)