1 ;;; elmo-cache.el -- Cache modules for Elmo.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 2000 Kenichi OKADA <okada@opaopa.org>
6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
7 ;; Kenichi OKADA <okada@opaopa.org>
8 ;; Keywords: mail, net news
10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
36 (defun elmo-cache-delete (msgid folder number)
37 "Delete cache file associated with message-id 'MSGID', FOLDER, NUMBER."
38 (let ((path (elmo-cache-exists-p msgid folder number)))
39 (if path (delete-file path))))
41 (defsubst elmo-cache-to-msgid (filename)
42 (concat "<" (elmo-recover-msgid-from-filename filename) ">"))
44 (defun elmo-cache-force-delete (path &optional locked)
47 (unless (string-match elmo-cache-dirname path)
48 (error "%s is not cache file!" path))
50 (if (or (elmo-msgdb-global-mark-get
52 (elmo-cache-to-msgid (file-name-nondirectory path))))
53 (member message-id locked))
54 nil;; Don't delete caches with mark (or locked message).
56 (file-directory-p path))
58 (mapcar 'delete-file (directory-files path t "^[^\\.]"))
59 (delete-directory path))
63 (defun elmo-cache-delete-partial (msgid folder number)
64 "Delete cache file only if it is partial message."
66 (let ((path1 (elmo-cache-get-path msgid))
69 (file-exists-p path1))
71 (file-directory-p path1))
72 (when (file-exists-p (setq path2
80 (unless (directory-files path1 t "^[^\\.]")
81 (delete-directory path1))))))))
83 (defun elmo-cache-read (msgid &optional folder number outbuf)
84 "Read cache contents to OUTBUF."
86 (let ((path (elmo-cache-exists-p msgid folder number)))
88 (if outbuf (set-buffer outbuf))
90 (as-binary-input-file (insert-file-contents path))
93 (defun elmo-cache-expire ()
95 (let* ((completion-ignore-case t)
96 (method (completing-read (format "Expire by (%s): "
97 elmo-cache-expire-default-method)
100 (if (string= method "")
101 (setq method elmo-cache-expire-default-method))
102 (funcall (intern (concat "elmo-cache-expire-by-" method)))))
104 (defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
105 (let ((str (read-from-minibuffer prompt initial)))
107 ((string-match "[0-9]*\\.[0-9]+" str)
108 (string-to-number str))
109 ((string-match "[0-9]+" str)
110 (string-to-number (concat str ".0")))
111 (t (error "%s is not number" str)))))
113 (defun elmo-cache-expire-by-size (&optional kbytes)
114 "Expire cache file by size.
115 If KBYTES is kilo bytes (This value must be float)."
117 (let ((size (or kbytes
119 (elmo-read-float-value-from-minibuffer
120 "Enter cache disk size (Kbytes): "
122 (if (integerp elmo-cache-expire-default-size)
123 (float elmo-cache-expire-default-size)
124 elmo-cache-expire-default-size))))
125 (if (integerp elmo-cache-expire-default-size)
126 (float elmo-cache-expire-default-size))))
127 (locked (elmo-dop-lock-list-load))
131 (message "Checking disk usage...")
132 (setq total (/ (elmo-disk-usage
134 elmo-cache-dirname elmo-msgdb-dir)) Kbytes))
135 (setq beginning total)
136 (message "Checking disk usage...done")
137 (let ((cfl (elmo-cache-get-sorted-cache-file-list))
141 (while (and (<= size total)
142 (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl)))
143 (setq cur-file (expand-file-name (car (cdr oldest)) (car oldest)))
144 (if (file-directory-p cur-file)
145 (setq cur-size (elmo-disk-usage cur-file))
147 (/ (float (nth 7 (file-attributes cur-file)))
149 (when (elmo-cache-force-delete cur-file locked)
150 (setq count (+ count 1))
151 (message "%d cache(s) are expired." count))
152 (setq deleted (+ deleted cur-size))
153 (setq total (- total cur-size)))
154 (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
155 count deleted beginning))))
157 (defun elmo-cache-make-file-entity (filename path)
158 (cons filename (elmo-get-last-accessed-time filename path)))
160 (defun elmo-cache-get-oldest-cache-file-entity (cache-file-list)
161 (let ((cfl cache-file-list)
162 flist firsts oldest-entity wonlist)
164 (setq flist (cdr (car cfl)))
165 (setq firsts (append firsts (list
166 (cons (car (car cfl))
168 (setq cfl (cdr cfl)))
171 (if (and (not oldest-entity)
172 (cdr (cdr (car firsts))))
173 (setq oldest-entity (car firsts)))
174 (if (and (cdr (cdr (car firsts)))
175 (cdr (cdr oldest-entity))
176 (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts)))))
177 (setq oldest-entity (car firsts)))
178 (setq firsts (cdr firsts)))
179 (setq wonlist (assoc (car oldest-entity) cache-file-list))
181 (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist))))
184 (defun elmo-cache-get-sorted-cache-file-list ()
185 (let ((dirs (directory-files
186 (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
191 (setq num (length dirs))
192 (message "Collecting cache info...")
194 (setq elist (mapcar (lambda (x)
195 (elmo-cache-make-file-entity x (car dirs)))
196 (directory-files (car dirs) nil "^[^\\.]")))
197 (setq ret-val (append ret-val
205 (when (> num elmo-display-progress-threshold)
207 (elmo-display-progress
208 'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
210 (setq dirs (cdr dirs)))
211 (message "Collecting cache info...done")
214 (defun elmo-cache-expire-by-age (&optional days)
215 (let ((age (or (and days (int-to-string days))
217 (read-from-minibuffer
218 (format "Enter days (%s): "
219 elmo-cache-expire-default-age)))
220 (int-to-string elmo-cache-expire-default-age)))
221 (dirs (directory-files
222 (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
224 (locked (elmo-dop-lock-list-load))
228 (setq age elmo-cache-expire-default-age)
229 (setq age (string-to-int age)))
230 (setq curtime (current-time))
231 (setq curtime (+ (* (nth 0 curtime)
232 (float 65536)) (nth 1 curtime)))
234 (let ((files (directory-files (car dirs) t "^[^\\.]"))
235 (limit-age (* age 86400)))
237 (when (> (- curtime (elmo-get-last-accessed-time (car files)))
239 (when (elmo-cache-force-delete (car files) locked)
240 (setq count (+ 1 count))
241 (message "%d cache file(s) are expired." count)))
242 (setq files (cdr files))))
243 (setq dirs (cdr dirs)))))
245 (defun elmo-cache-save (msgid partial folder number &optional inbuf)
246 "If PARTIAL is non-nil, save current buffer (or INBUF) as partial cache."
249 (let* ((path (if partial
250 (elmo-cache-get-path msgid folder number)
251 (elmo-cache-get-path msgid)))
254 (setq dir (directory-file-name (file-name-directory path)))
255 (if (not (file-exists-p dir))
256 (elmo-make-directory dir))
257 (if inbuf (set-buffer inbuf))
258 (goto-char (point-min))
259 (as-binary-output-file (write-region (point-min) (point-max)
260 path nil 'no-msg)))))
263 (defun elmo-cache-exists-p (msgid &optional folder number)
264 "Returns the path if the cache exists."
267 (let ((path (elmo-cache-get-path msgid)))
269 (file-exists-p path))
271 (file-directory-p path))
272 (if (file-exists-p (setq path (expand-file-name
283 (defun elmo-cache-search-all (folder condition from-msgs)
284 (let* ((number-alist (elmo-msgdb-number-load
285 (elmo-msgdb-expand-path folder)))
286 (number-list (or from-msgs (mapcar 'car number-alist)))
287 (num (length number-alist))
294 (if (and (memq (car (car number-alist)) number-list)
295 (setq cache-file (elmo-cache-exists-p (cdr (car
300 (elmo-file-field-condition-match cache-file condition
301 (car (car number-alist))
303 (setq ret-val (append ret-val (list (caar number-alist)))))
304 (when (> num elmo-display-progress-threshold)
306 (setq percent (/ (* i 100) num))
307 (elmo-display-progress
308 'elmo-cache-search-all "Searching..."
310 (setq number-alist (cdr number-alist)))
313 (defun elmo-cache-collect-sub-directories (init dir &optional recursively)
314 "Collect subdirectories under DIR."
316 (delete (expand-file-name elmo-cache-dirname
318 (directory-files dir t "^[^\\.]")))
320 (setq dirs (elmo-delete-if (lambda (x) (not (file-directory-p x))) dirs))
321 (setq ret-val (append init dirs))
322 (while (and recursively dirs)
324 (elmo-cache-collect-sub-directories
326 (car dirs) recursively))
327 (setq dirs (cdr dirs)))
330 (defun elmo-msgid-to-cache (msgid)
332 (string-match "<\\(.+\\)>$" msgid))
333 (elmo-replace-msgid-as-filename (elmo-match-string 1 msgid))))
335 (defun elmo-cache-get-path (msgid &optional folder number)
336 "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
337 (if (setq msgid (elmo-msgid-to-cache msgid))
341 (format "%s/%s/%s@%s"
342 (elmo-cache-get-path-subr msgid)
345 (elmo-safe-filename folder))
347 (elmo-cache-get-path-subr msgid)
349 (expand-file-name elmo-cache-dirname
352 (defsubst elmo-cache-get-path-subr (msgid)
353 (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
354 (clist (string-to-char-list msgid))
357 (setq sum (+ sum (car clist)))
358 (setq clist (cdr clist)))
360 (nth (% (/ sum 16) 2) chars)
361 (nth (% sum 16) chars))))
364 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
365 ;; buffer cache module
367 (defconst elmo-buffer-cache-name " *elmo cache*")
369 (defvar elmo-buffer-cache nil
370 "Message cache. (old ... new) order alist.
371 With association ((\"folder\" message \"message-id\") . cache-buffer).")
373 (defmacro elmo-buffer-cache-buffer-get (entry)
376 (defmacro elmo-buffer-cache-folder-get (entry)
377 (` (car (car (, entry)))))
379 (defmacro elmo-buffer-cache-message-get (entry)
380 (` (cdr (car (, entry)))))
382 (defmacro elmo-buffer-cache-entry-make (fld-msg-id buf)
383 (` (cons (, fld-msg-id) (, buf))))
385 (defmacro elmo-buffer-cache-hit (fld-msg-id)
386 "Return value assosiated with key."
387 (` (elmo-buffer-cache-buffer-get
388 (assoc (, fld-msg-id) elmo-buffer-cache))))
390 (defun elmo-buffer-cache-sort (entry)
391 (let* ((pointer (cons nil elmo-buffer-cache))
394 (if (equal (car (cdr pointer)) entry)
395 (setcdr pointer (cdr (cdr pointer)))
396 (setq pointer (cdr pointer))))
397 (setcdr pointer (list entry))
398 (setq elmo-buffer-cache (cdr top))))
400 (defun elmo-buffer-cache-add (fld-msg-id)
401 "Adding (FLD-MSG-ID . buf) to the top of `elmo-buffer-cache'.
402 Returning its cache buffer."
403 (let ((len (length elmo-buffer-cache))
405 (if (< len elmo-buffer-cache-size)
406 (setq buf (get-buffer-create (format "%s%d" elmo-buffer-cache-name len)))
407 (setq buf (elmo-buffer-cache-buffer-get (nth (1- len) elmo-buffer-cache)))
408 (setcdr (nthcdr (- len 2) elmo-buffer-cache) nil))
411 (elmo-set-buffer-multibyte nil))
412 (setq elmo-buffer-cache
413 (cons (elmo-buffer-cache-entry-make fld-msg-id buf)
417 (defun elmo-buffer-cache-delete ()
418 "Delete the most recent cache entry."
419 (let ((buf (elmo-buffer-cache-buffer-get (car elmo-buffer-cache))))
420 (setq elmo-buffer-cache
421 (nconc (cdr elmo-buffer-cache)
422 (list (elmo-buffer-cache-entry-make nil buf))))))
424 (defun elmo-buffer-cache-clean-up ()
425 "A function to flush all decoded messages in cache list."
428 (while (< n elmo-buffer-cache-size)
429 (setq buf (concat elmo-buffer-cache-name (int-to-string n)))
430 (elmo-kill-buffer buf)
432 (setq elmo-buffer-cache nil))
435 ;; cache backend by Kenichi OKADA <okada@opaopa.org>
438 (defsubst elmo-cache-get-folder-directory (spec)
439 (if (file-name-absolute-p (nth 1 spec))
440 (nth 1 spec) ; already full path.
441 (expand-file-name (nth 1 spec)
442 (expand-file-name elmo-cache-dirname elmo-msgdb-dir))))
444 (defun elmo-cache-msgdb-expand-path (spec)
445 (let ((fld-name (nth 1 spec)))
446 (expand-file-name fld-name
447 (expand-file-name "internal/cache"
450 (defun elmo-cache-number-to-filename (spec number)
452 (elmo-cache-list-folder-subr spec nil t)))
454 (cdr (assq number number-alist)))))
456 (if (boundp 'nemacs-version)
457 (defsubst elmo-cache-insert-header (file)
458 "Insert the header of the article (Does not work on nemacs)."
459 (as-binary-input-file
460 (insert-file-contents file)))
461 (defsubst elmo-cache-insert-header (file)
462 "Insert the header of the article."
464 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
465 insert-file-contents-post-hook
467 (when (file-exists-p file)
468 ;; Read until header separator is found.
469 (while (and (eq elmo-localdir-header-chop-length
471 (as-binary-input-file
472 (insert-file-contents
474 (incf beg elmo-localdir-header-chop-length)))))
475 (prog1 (not (search-forward "\n\n" nil t))
476 (goto-char (point-max)))))))))
478 (defsubst elmo-cache-msgdb-create-overview-entity-from-file (number file)
480 (let ((tmp-buffer (get-buffer-create " *ELMO Cache Temp*"))
481 insert-file-contents-pre-hook ; To avoid autoconv-xmas...
482 insert-file-contents-post-hook header-end
483 (attrib (file-attributes file))
485 (set-buffer tmp-buffer)
487 (if (not (file-exists-p file))
489 (setq size (nth 7 attrib))
490 (setq mtime (timezone-make-date-arpa-standard
491 (current-time-string (nth 5 attrib)) (current-time-zone)))
492 ;; insert header from file.
495 (elmo-cache-insert-header file)
496 (error (throw 'done nil)))
497 (goto-char (point-min))
499 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
502 (narrow-to-region (point-min) header-end)
503 (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
504 (kill-buffer tmp-buffer))
507 (defun elmo-cache-msgdb-create-as-numlist (spec numlist new-mark
508 already-mark seen-mark
509 important-mark seen-list)
511 (let ((dir (elmo-cache-get-folder-directory spec))
512 (nalist (elmo-cache-list-folder-subr spec nil t))
513 overview number-alist mark-alist entity message-id
514 i percent len num seen gmark)
515 (setq len (length numlist))
517 (message "Creating msgdb...")
520 (elmo-cache-msgdb-create-overview-entity-from-file
524 (setq message-id (cdr (assq (car numlist) nalist)))) dir)))
527 (setq num (elmo-msgdb-overview-entity-get-number entity))
529 (elmo-msgdb-append-element
532 (elmo-msgdb-number-add number-alist num message-id))
533 (setq seen (member message-id seen-list))
534 (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
539 (elmo-msgdb-mark-append
543 (when (> len elmo-display-progress-threshold)
545 (setq percent (/ (* i 100) len))
546 (elmo-display-progress
547 'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
549 (setq numlist (cdr numlist)))
550 (message "Creating msgdb...done")
551 (list overview number-alist mark-alist))))
553 (defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist)
555 (defun elmo-cache-list-folders (spec &optional hierarchy)
556 (let ((folder (concat "'cache" (nth 1 spec))))
557 (elmo-cache-list-folders-subr folder hierarchy)))
559 (defun elmo-cache-list-folders-subr (folder &optional hierarchy)
560 (let ((case-fold-search t)
561 folders curdir dirent relpath abspath attr
567 (nth 1 (elmo-folder-get-spec folder))
568 (expand-file-name elmo-cache-dirname elmo-msgdb-dir)))
569 (if (string-match "^[+=$!]$" folder) ; localdir, archive, localnews
570 (setq subprefix folder)
571 (setq subprefix (concat folder elmo-path-sep)))
573 ;(setq folders (list folder)))
574 (setq dirent (directory-files curdir nil "^[01][0-9A-F]$"))
577 (setq relpath (car dirent))
578 (setq dirent (cdr dirent))
579 (setq abspath (expand-file-name relpath curdir))
581 (eq (nth 0 (setq attr (file-attributes abspath))) t)
582 (setq subfolder (concat subprefix relpath))
583 (setq folders (nconc folders (list subfolder))))))
585 (file-error folders))))
587 (defsubst elmo-cache-list-folder-subr (spec &optional nonsort nonalist)
588 (let* ((dir (elmo-cache-get-folder-directory spec))
589 (flist (mapcar 'file-name-nondirectory
590 (elmo-delete-if 'file-directory-p
592 dir t "^[^@]+@[^@]+$" t))))
593 (folder (concat "'cache/" (nth 1 spec)))
594 (number-alist (or (elmo-msgdb-number-load
595 (elmo-msgdb-expand-path folder))
599 (mapcar '(lambda (filename)
600 (elmo-cache-filename-to-number filename number-alist))
605 (cons (or (elmo-max-of-list nlist) 0) (length nlist))
608 (defsubst elmo-cache-filename-to-number (filename number-alist)
609 (let* ((msgid (elmo-cache-to-msgid filename))
611 (or (car (rassoc msgid number-alist))
613 (setq number (+ (or (caar (last number-alist))
615 (if (car number-alist)
617 (list (cons number msgid)))
618 (setcar number-alist (cons number msgid)))))))
620 (defun elmo-cache-append-msg (spec string message-id &optional msg no-see)
621 (let ((dir (elmo-cache-get-folder-directory spec))
622 (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
625 (set-buffer tmp-buffer)
627 (setq filename (expand-file-name (elmo-msgid-to-cache message-id) dir))
629 (if (file-writable-p filename)
632 (as-binary-output-file
633 (write-region (point-min) (point-max) filename nil 'no-msg))
636 (kill-buffer tmp-buffer)))))
638 (defun elmo-cache-delete-msg (spec number locked)
639 (let* ((dir (elmo-cache-get-folder-directory spec))
640 (file (expand-file-name
641 (elmo-cache-number-to-filename spec number) dir)))
642 ;; return nil if failed.
643 (elmo-cache-force-delete file locked)))
645 (defun elmo-cache-read-msg (spec number outbuf &optional set-mark)
647 (let* ((dir (elmo-cache-get-folder-directory spec))
648 (file (expand-file-name
649 (elmo-cache-number-to-filename spec number) dir)))
652 (when (file-exists-p file)
653 (as-binary-input-file (insert-file-contents file))
654 (elmo-delete-cr-get-content-type)))))
656 (defun elmo-cache-delete-msgs (spec msgs)
657 (let ((locked (elmo-dop-lock-list-load)))
659 (mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked))
662 (defun elmo-cache-list-folder (spec) ; called by elmo-cache-search()
663 (let ((killed (and elmo-use-killed-list
664 (elmo-msgdb-killed-list-load
665 (elmo-msgdb-expand-path spec))))
667 (setq numbers (elmo-cache-list-folder-subr spec))
668 (elmo-living-messages numbers killed)))
670 (defun elmo-cache-max-of-folder (spec)
671 (elmo-cache-list-folder-subr spec t))
673 (defun elmo-cache-check-validity (spec validity-file)
676 (defun elmo-cache-sync-validity (spec validity-file)
679 (defun elmo-cache-folder-exists-p (spec)
680 (file-directory-p (elmo-cache-get-folder-directory spec)))
682 (defun elmo-cache-folder-creatable-p (spec)
685 (defun elmo-cache-create-folder (spec)
688 (defun elmo-cache-search (spec condition &optional from-msgs)
689 (let* ((number-alist (elmo-cache-list-folder-subr spec nil t))
690 (msgs (or from-msgs (mapcar 'car number-alist)))
692 (i 0) case-fold-search ret-val)
694 (if (elmo-file-field-condition-match
697 (cdr (assq (car msgs) number-alist)))
698 (elmo-cache-get-folder-directory spec))
702 (setq ret-val (cons (car msgs) ret-val)))
703 (when (> num elmo-display-progress-threshold)
705 (elmo-display-progress
706 'elmo-cache-search "Searching..."
708 (setq msgs (cdr msgs)))
711 ;;; (localdir, maildir, localnews) -> cache
712 (defun elmo-cache-copy-msgs (dst-spec msgs src-spec
713 &optional loc-alist same-number)
715 (elmo-cache-get-folder-directory dst-spec))
716 (next-num (1+ (car (elmo-cache-list-folder-subr dst-spec t))))
718 (elmo-msgdb-number-load
719 (elmo-msgdb-expand-path src-spec))))
720 (if same-number (error "Not implemented"))
724 (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
728 (cdr (assq (if same-number (car msgs) next-num) number-alist)))
730 (if (and (setq msgs (cdr msgs))
732 (setq next-num (1+ next-num))))
735 (defun elmo-cache-use-cache-p (spec number)
738 (defun elmo-cache-local-file-p (spec number)
741 (defun elmo-cache-get-msg-filename (spec number &optional loc-alist)
743 (elmo-cache-number-to-filename spec number)
744 (elmo-cache-get-folder-directory spec)))
746 (defalias 'elmo-cache-sync-number-alist
747 'elmo-generic-sync-number-alist)
748 (defalias 'elmo-cache-list-folder-unread
749 'elmo-generic-list-folder-unread)
750 (defalias 'elmo-cache-list-folder-important
751 'elmo-generic-list-folder-important)
752 (defalias 'elmo-cache-commit 'elmo-generic-commit)
753 (defalias 'elmo-cache-folder-diff 'elmo-generic-folder-diff)
756 (product-provide (provide 'elmo-cache) (require 'elmo-version))
758 ;;; elmo-cache.el ends here