;;; url-cache.el --- Uniform Resource Locator retrieval tool
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(defcustom url-cache-directory
(expand-file-name "cache" url-configuration-directory)
- "*The directory where cache files should be stored."
+ "The directory where cache files should be stored."
:type 'directory
:group 'url-file)
+(defcustom url-cache-expire-time 3600
+ "Default maximum time in seconds before cache files expire.
+Used by the function `url-cache-expired'."
+ :version "24.1"
+ :type 'integer
+ :group 'url-cache)
+
;; Cache manager
(defun url-cache-file-writable-p (file)
"Follows the documentation of `file-writable-p', unlike `file-writable-p'."
that would stop this. Returns nil if parent directories can not be
created. If FILE already exists as a non-directory, it changes
permissions of FILE or deletes FILE to make it possible to write a new
-version of FILE. Returns nil if this can not be done. Returns nil if
-FILE already exists as a directory. Otherwise, returns t, indicating that
+version of FILE. Returns nil if this can not be done, or if FILE already
+exists as a directory. Otherwise, returns t, indicating that
FILE can be created or overwritten."
(cond
((url-cache-file-writable-p file)
;;;###autoload
(defun url-store-in-cache (&optional buff)
"Store buffer BUFF in the cache."
- (if (not (and buff (get-buffer buff)))
- nil
- (save-current-buffer
- (and buff (set-buffer buff))
- (let* ((fname (url-cache-create-filename (url-view-url t))))
- (if (url-cache-prepare fname)
- (let ((coding-system-for-write 'binary))
- (write-region (point-min) (point-max) fname nil 5)))))))
+ (with-current-buffer (get-buffer (or buff (current-buffer)))
+ (let ((fname (url-cache-create-filename (url-view-url t))))
+ (if (url-cache-prepare fname)
+ (let ((coding-system-for-write 'binary))
+ (write-region (point-min) (point-max) fname nil 5))))))
+
+(defun url-fetch-from-cache (url)
+ "Fetch URL from cache and return a buffer with the content."
+ (with-current-buffer (generate-new-buffer " *temp*")
+ (url-cache-extract (url-cache-create-filename url))
+ (current-buffer)))
;;;###autoload
(defun url-is-cached (url)
- "Return non-nil if the URL is cached."
+ "Return non-nil if the URL is cached.
+The actual return value is the last modification time of the cache file."
(let* ((fname (url-cache-create-filename url))
(attribs (file-attributes fname)))
(and fname ; got a filename
(nth 5 attribs)))) ; Can get last mod-time
(defun url-cache-create-filename-human-readable (url)
- "Return a filename in the local cache for URL"
+ "Return a filename in the local cache for URL."
(if url
- (let* ((url (if (vectorp url) (url-recreate-url url) url))
- (urlobj (url-generic-parse-url url))
+ (let* ((urlobj (url-generic-parse-url url))
(protocol (url-type urlobj))
(hostname (url-host urlobj))
(host-components
(user-real-login-name)
(cons (or protocol "file")
(reverse (split-string (or hostname "localhost")
- (eval-when-compile
- (regexp-quote ".")))))))
+ "\\.")))))
(fname (url-filename urlobj)))
(if (and fname (/= (length fname) 0) (= (aref fname 0) ?/))
(setq fname (substring fname 1 nil)))
Very fast if you have an `md5' primitive function, suitably fast otherwise."
(require 'md5)
(if url
- (let* ((url (if (vectorp url) (url-recreate-url url) url))
- (checksum (md5 url))
+ (let* ((checksum (md5 url))
(urlobj (url-generic-parse-url url))
(protocol (url-type urlobj))
(hostname (url-host urlobj))
(nreverse
(delq nil
(split-string (or hostname "localhost")
- (eval-when-compile
- (regexp-quote "."))))))))
+ "\\."))))))
(fname (url-filename urlobj)))
(and fname
(expand-file-name checksum
url-cache-directory))))))
(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
- "*What function to use to create a cached filename."
+ "What function to use to create a cached filename."
:type '(choice (const :tag "MD5 of filename (low collision rate)"
:value url-cache-create-filename-using-md5)
(const :tag "Human readable filenames (higher collision rate)"
:group 'url-cache)
(defun url-cache-create-filename (url)
- (funcall url-cache-creation-function url))
+ (funcall url-cache-creation-function
+ ;; We need to parse+recreate in order to remove the default port
+ ;; if it has been specified: e.g. http://www.example.com:80 will
+ ;; be transcoded as http://www.example.com
+ (url-recreate-url
+ (if (vectorp url) url
+ (url-generic-parse-url url)))))
;;;###autoload
(defun url-cache-extract (fnam)
- "Extract FNAM from the local disk cache"
+ "Extract FNAM from the local disk cache."
(erase-buffer)
(insert-file-contents-literally fnam))
-;;;###autoload
-(defun url-cache-expired (url mod)
- "Return t if a cached file has expired."
- (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url)))
- (type (url-type urlobj)))
- (cond
- (url-standalone-mode
- (not (file-exists-p (url-cache-create-filename url))))
- ((string= type "http")
- t)
- ((member type '("file" "ftp"))
- (if (or (equal mod '(0 0)) (not mod))
- t
- (or (> (nth 0 mod) (nth 0 (current-time)))
- (> (nth 1 mod) (nth 1 (current-time))))))
- (t nil))))
+(defun url-cache-expired (url &optional expire-time)
+ "Return non-nil if a cached URL is older than EXPIRE-TIME seconds.
+The default value of EXPIRE-TIME is `url-cache-expire-time'.
+If `url-standalone-mode' is non-nil, cached items never expire."
+ (if url-standalone-mode
+ (not (file-exists-p (url-cache-create-filename url)))
+ (let ((cache-time (url-is-cached url)))
+ (or (not cache-time)
+ (time-less-p
+ (time-add
+ cache-time
+ (seconds-to-time (or expire-time url-cache-expire-time)))
+ (current-time))))))
(provide 'url-cache)