diff options
| -rw-r--r-- | lisp/url/ChangeLog | 6 | ||||
| -rw-r--r-- | lisp/url/url-cache.el | 26 | ||||
| -rw-r--r-- | lisp/url/url.el | 7 |
3 files changed, 39 insertions, 0 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 9285961fb3..4e748fbd99 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,5 +1,11 @@ 2012-02-06 Lars Ingebrigtsen <[email protected]> + * url-cache.el (url-cache-prune-cache): New function. + + * url.el (url-retrieve-number-of-calls): New variable. + (url-retrieve-internal): Use it to expire the cache once in a + while. + * url-queue.el (url-queue-setup-runners): New function that uses `run-with-idle-timer' for extra asynchronicity. (url-queue-remove-jobs-from-host): New function. diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 20602a2f8e..8fec249567 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -209,6 +209,32 @@ If `url-standalone-mode' is non-nil, cached items never expire." (seconds-to-time (or expire-time url-cache-expire-time))) (current-time)))))) +(defun url-cache-prune-cache (&optional directory) + "Remove all expired files from the cache. +`url-cache-expire-time' says how old a file has to be to be +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))) + (provide 'url-cache) ;;; url-cache.el ends here diff --git a/lisp/url/url.el b/lisp/url/url.el index 883e1a0c76..03b66b1523 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -119,6 +119,9 @@ Sometimes while retrieving a URL, the URL library needs to use another buffer than the one returned initially by `url-retrieve'. In this case, it sets this variable in the original buffer as a forwarding pointer.") +(defvar url-retrieve-number-of-calls 0) +(autoload 'url-cache-prune-cache "url-cache") + ;;;###autoload (defun url-retrieve (url callback &optional cbargs silent) "Retrieve URL asynchronously and call CALLBACK with CBARGS when finished. @@ -174,6 +177,10 @@ If SILENT, don't message progress reports and the like." (unless (url-type url) (error "Bad url: %s" (url-recreate-url url))) (setf (url-silent url) silent) + ;; Once in a while, remove old entries from the URL cache. + (when (zerop (% url-retrieve-number-of-calls 1000)) + (url-cache-prune-cache)) + (setq url-retrieve-number-of-calls (1+ url-retrieve-number-of-calls)) (let ((loader (url-scheme-get-property (url-type url) 'loader)) (url-using-proxy (if (url-host url) (url-find-proxy-for-url url (url-host url)))) |