Gnus development mailing list
 help / color / mirror / Atom feed
* patch for gnus-cache.el
@ 2000-08-08 12:19 Arnd Kohrs
  0 siblings, 0 replies; only message in thread
From: Arnd Kohrs @ 2000-08-08 12:19 UTC (permalink / raw)


[-- Attachment #1: Type: text/plain, Size: 765 bytes --]


Hi,

gnus-cache couldn't cope with the fact that are compressed on disk,
e.g. 42.gz instead of 42.  Gnus-cache would only look for uncompressed
versions of the file.

I fixed that by using a similar approach as in nnml, i.e. filename for
articles are looked up in an alist so that article number and filename
may differ with respect to extension.

Additionally, I added another optional argument to
gnus-cache-possibly-enter-article for specifying a buffer where the
article can be found so that redundant refetching can be avoided - if
desired.  I need this optional argument for a prefetch-to-cache feature
which I am working on.

Could somebody with the proper rights please add the patch below to the
CVS and notify me when it's done.  Thanks.

Cheers,
Arnd.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch for gnus-cache.el --]
[-- Type: text/x-patch, Size: 7953 bytes --]

Index: lisp/gnus-cache.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/gnus-cache.el,v
retrieving revision 5.23
diff -u -r5.23 gnus-cache.el
--- lisp/gnus-cache.el	2000/06/05 02:42:34	5.23
+++ lisp/gnus-cache.el	2000/08/03 12:05:13
@@ -113,7 +113,9 @@
   "Shut down the cache."
   (gnus-cache-write-active)
   (gnus-cache-save-buffers)
-  (setq gnus-cache-active-hashtb nil))
+  (setq gnus-cache-active-hashtb nil
+        gnus-cache-article-file-alist nil
+        gnus-cache-article-file-alist-current-dir nil))
 
 (defun gnus-cache-save-buffers ()
   ;; save the overview buffer if it exists and has been modified
@@ -146,7 +148,10 @@
       (setq gnus-cache-buffer nil))))
 
 (defun gnus-cache-possibly-enter-article
-  (group article ticked dormant unread &optional force)
+  (group article ticked dormant unread &optional force from-buffer)
+  "If from-buffer, it is assumed that the from-buffer contains the
+article to be cached and the article is read from the buffer instead
+of fetching it form the backend. Arnd."
   (when (and (or force (not (eq gnus-use-cache 'passive)))
 	     (numberp article)
 	     (> article 0))		; This might be a dummy article.
@@ -175,11 +180,14 @@
 	(if (file-exists-p file)
 	    t				; The article already is saved.
 	  (save-excursion
-	    (set-buffer nntp-server-buffer)
-	    (require 'gnus-art)
-	    (let ((gnus-use-cache nil)
-		  (gnus-article-decode-hook nil))
-	      (gnus-request-article-this-buffer number group))
+            ;; Arnd: The article has already been loaded to the
+            ;; from-buffer, therefore no need for fetching it again.
+            (set-buffer (or from-buffer nntp-server-buffer))
+            (when (not from-buffer)
+              (require 'gnus-art)
+              (let ((gnus-use-cache nil)
+                    (gnus-article-decode-hook nil))
+                (gnus-request-article-this-buffer number group)))
 	    (when (> (buffer-size) 0)
 	      (let ((coding-system-for-write gnus-cache-coding-system))
 		(gnus-write-buffer file))
@@ -211,8 +219,14 @@
 	      (set-buffer gnus-summary-buffer)
 	      (gnus-cache-update-active group number)
 	      (push article gnus-newsgroup-cached)
-	      (gnus-summary-update-secondary-mark article))
-	    t))))))
+	      (gnus-summary-update-secondary-mark article)
+              ;; Add entry for the new file to the article-file lookup
+              ;; structure. Arnd.
+              (let ((file-wo-dir (file-name-nondirectory file)))
+                (push (cons (nnheader-file-to-number file-wo-dir) 
+                            file-wo-dir) 
+                      gnus-cache-article-file-alist)))
+            t))))))
 
 (defun gnus-cache-enter-remove-article (article)
   "Mark ARTICLE for later possible removal."
@@ -410,20 +424,24 @@
       (and (not unread) (not ticked) (not dormant) (memq 'read class))))
 
 (defun gnus-cache-file-name (group article)
-  (concat (file-name-as-directory gnus-cache-directory)
-	  (file-name-as-directory
-	   (nnheader-translate-file-chars
-	    (if (gnus-use-long-file-name 'not-cache)
-		group
-	      (let ((group (nnheader-replace-duplicate-chars-in-string
-			    (nnheader-replace-chars-in-string group ?/ ?_)
-			    ?. ?_)))
-		;; Translate the first colon into a slash.
-		(when (string-match ":" group)
-		  (aset group (match-beginning 0) ?/))
-		(nnheader-replace-chars-in-string group ?. ?/)))
-	    t))
-	  (if (stringp article) article (int-to-string article))))
+  (let ((dir (concat (file-name-as-directory gnus-cache-directory)
+                      (file-name-as-directory
+                       (nnheader-translate-file-chars
+                        (if (gnus-use-long-file-name 'not-cache)
+                            group
+                          (let ((group (nnheader-replace-duplicate-chars-in-string
+                                        (nnheader-replace-chars-in-string group ?/ ?_)
+                                        ?. ?_)))
+                            ;; Translate the first colon into a slash.
+                            (when (string-match ":" group)
+                              (aset group (match-beginning 0) ?/))
+                            (nnheader-replace-chars-in-string group ?. ?/)))
+                        t)))))
+    (concat dir
+            (or (and (stringp article) article)
+                (and (gnus-cache-update-file-alist dir)
+                     (cdr (assoc article gnus-cache-article-file-alist)))
+                (int-to-string article)))))
 
 (defun gnus-cache-update-article (group article)
   "If ARTICLE is in the cache, remove it and re-enter it."
@@ -453,6 +471,13 @@
 		    gnus-cache-remove-articles ticked dormant unread)))
       (save-excursion
 	(delete-file file)
+        ;; remove files entry from the article-file lookup structure.
+        ;; There is no need to call gnus-cache-update-file-alist,
+        ;; since it is done implicitly by gnus-cache-file-name. Arnd.
+        (let ((art-file (assq article gnus-cache-article-file-alist)))
+          (and art-file
+               (setq gnus-cache-article-file-alist 
+                     (delete art-file gnus-cache-article-file-alist))))
 	(set-buffer (cdr gnus-cache-buffer))
 	(goto-char (point-min))
 	(when (or (looking-at (concat (int-to-string number) "\t"))
@@ -460,8 +485,8 @@
 				  (point-max) t))
 	  (delete-region (progn (beginning-of-line) (point))
 			 (progn (forward-line 1) (point)))))
-      (setq gnus-newsgroup-cached
-	    (delq article gnus-newsgroup-cached))
+      (setq gnus-newsgroup-cached 
+           (delq article gnus-newsgroup-cached))
       (gnus-summary-update-secondary-mark article)
       t)))
 
@@ -674,6 +699,50 @@
   (interactive "FMove the cache tree to: ")
   (rename-file gnus-cache-directory dir))
 
+;; Arnd Kohrs 8/2000: cache does not properly collaborate with
+;; jka-compr, i.e. it used to look only for uncompressed files.  Now
+;; the same technique as in nnml is used: The articles are mapped on
+;; file names (without path) by the following the
+;; gnus-cache-article-file-alist:
+
+(defvar gnus-cache-article-file-alist nil 
+"Alist which contains mappings from article numbers to directory-less
+filenames. Filenames might differ from article numbers in case
+compression or encryption is in place ")
+
+(defvar gnus-cache-article-file-alist-current-dir nil
+"The name of the directory to which the entries in
+gnus-cache-article-file-alist correspond."  )
+
+(defun gnus-cache-update-file-alist (dir &optional force)
+  "Update the gnus-cache-article-file-alist with the contents of the
+directory dir.  When the alist already contains entries of dir nothing
+is done.  When force then the alist is updated anyway.  This function
+should be called before accessing gnus-cache-article-file-alist."
+  (when (or (not gnus-cache-article-file-alist)
+            (not (equal dir gnus-cache-article-file-alist-current-dir))
+	    force)
+    (gnus-make-directory dir)
+    (setq gnus-cache-article-file-alist-current-dir dir)
+    (setq gnus-cache-article-file-alist
+	  (nnheader-article-to-file-alist dir))))
+
+(defun gnus-cache-update-cached-articles ()
+  "Add all articles which are located in the cache-directory to
+gnus-newsgroup-cached. This function should be called from the summary
+buffer.  This function is meant as a fix in case cached articles which
+were ignored in gnus-newsgroup-cached because they weren't found by
+the previously buggy gnus-cache which ignored compressed articles."
+  (interactive)
+  (with-current-buffer gnus-summary-buffer
+    (gnus-cache-file-name gnus-newsgroup-name 1)
+    (mapcar (lambda (art-file)
+              (progn (push (car art-file) gnus-newsgroup-cached)
+                     (gnus-summary-update-secondary-mark (car art-file))))
+            gnus-cache-article-file-alist)))
+
+
 (provide 'gnus-cache)
 
 ;;; gnus-cache.el ends here
+

[-- Attachment #3: Type: text/plain, Size: 204 bytes --]


-- 
Arnd Kohrs  -  Institut Eurecom - http://www.eurecom.fr/~kohrs
              
The Active WebMuseum: Your personalized access to art paintings.
 Visit now ->  http://www.eurecom.fr/~kohrs/museum.html

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2000-08-08 12:19 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2000-08-08 12:19 patch for gnus-cache.el Arnd Kohrs

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).