;;; url-cache.el --- Uniform Resource Locator retrieval tool
-;; Copyright (C) 1996-1999, 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2004-2012 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
(defun url-cache-extract (fnam)
"Extract FNAM from the local disk cache."
(erase-buffer)
+ (set-buffer-multibyte nil)
(insert-file-contents-literally fnam))
(defun url-cache-expired (url &optional expire-time)
(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))
+ (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)
;;; url-cache.el ends here