]> code.delx.au - gnu-emacs/blobdiff - lisp/url/url-cache.el
Update copyright year to 2015
[gnu-emacs] / lisp / url / url-cache.el
index 20602a2f8ef0d1e669ac5dbd099b15b15bf8d9e4..8e9d128b56c934001325d78366e6a37f6a904e5c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; url-cache.el --- Uniform Resource Locator retrieval tool
 
-;; Copyright (C) 1996-1999, 2004-201 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2015 Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes, hypermedia
 
@@ -149,7 +149,6 @@ The actual return value is the last modification time of the cache file."
 (defun url-cache-create-filename-using-md5 (url)
   "Create a cached filename using MD5.
 Very fast if you have an `md5' primitive function, suitably fast otherwise."
-  (require 'md5)
   (if url
       (let* ((checksum (md5 url))
             (urlobj (url-generic-parse-url url))
@@ -209,6 +208,34 @@ 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 ((now (current-time))
+       (total-files 0)
+       (deleted-files 0))
+    (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))
+            now)
+           (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