elmo/elmo-cache.el

   1 ;;; elmo-cache.el -- Cache modules for Elmo.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright (C) 2000 Kenichi OKADA <okada@opaopa.org>
   5
   6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   7 ;;      Kenichi OKADA <okada@opaopa.org>
   8 ;; Keywords: mail, net news
   9
  10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  11
  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)
  15 ;; any later version.
  16 ;;
  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.
  21 ;;
  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.
  26 ;;
  27
  28 ;;; Commentary:
  29 ;;
  30
  31 ;;; Code:
  32 ;;
  33 (require 'elmo-vars)
  34 (require 'elmo-util)
  35
  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))))
  40
  41 (defsubst elmo-cache-to-msgid (filename)
  42   (concat "<" (elmo-recover-msgid-from-filename filename) ">"))
  43
  44 (defun elmo-cache-force-delete (path &optional locked)
  45   "Delete cache file."
  46   ;; for safety...
  47   (unless (string-match elmo-cache-dirname path)
  48     (error "%s is not cache file!" path))
  49   (let (message-id)
  50     (if (or (elmo-msgdb-global-mark-get
  51              (setq message-id
  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).
  55       (if (and path
  56                (file-directory-p path))
  57           (progn
  58             (mapcar 'delete-file (directory-files path t "^[^\\.]"))
  59             (delete-directory path))
  60         (delete-file path))
  61       t)))
  62
  63 (defun elmo-cache-delete-partial (msgid folder number)
  64   "Delete cache file only if it is partial message."
  65   (if msgid
  66       (let ((path1 (elmo-cache-get-path msgid))
  67             path2)
  68         (if (and path1
  69                  (file-exists-p path1))
  70             (if (and folder
  71                      (file-directory-p path1))
  72                 (when (file-exists-p (setq path2
  73                                            (expand-file-name
  74                                             (format "%s@%s"
  75                                                     number
  76                                                     (elmo-safe-filename
  77                                                      folder))
  78                                             path1)))
  79                   (delete-file path2)
  80                   (unless (directory-files path1 t "^[^\\.]")
  81                     (delete-directory path1))))))))
  82
  83 (defun elmo-cache-read (msgid &optional folder number outbuf)
  84   "Read cache contents to OUTBUF."
  85   (save-excursion
  86     (let ((path (elmo-cache-exists-p msgid folder number)))
  87       (when path
  88         (if outbuf (set-buffer outbuf))
  89         (erase-buffer)
  90         (as-binary-input-file (insert-file-contents path))
  91         t))))
  92
  93 (defun elmo-cache-expire ()
  94   (interactive)
  95   (let* ((completion-ignore-case t)
  96          (method (completing-read (format "Expire by (%s): "
  97                                           elmo-cache-expire-default-method)
  98                                   '(("size" . "size")
  99                                     ("age" . "age")))))
 100     (if (string= method "")
 101         (setq method elmo-cache-expire-default-method))
 102     (funcall (intern (concat "elmo-cache-expire-by-" method)))))
 103
 104 (defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
 105   (let ((str (read-from-minibuffer prompt initial)))
 106     (cond
 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)))))
 112
 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)."
 116   (interactive)
 117   (let ((size (or kbytes
 118                   (and (interactive-p)
 119                        (elmo-read-float-value-from-minibuffer
 120                         "Enter cache disk size (Kbytes): "
 121                         (number-to-string
 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))
 128         (count 0)
 129         (Kbytes 1024)
 130         total beginning)
 131     (message "Checking disk usage...")
 132     (setq total (/ (elmo-disk-usage
 133                     (expand-file-name
 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))
 138           (deleted 0)
 139           oldest
 140           cur-size cur-file)
 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         (setq cur-size (/ (elmo-disk-usage cur-file) Kbytes))
 145         (when (elmo-cache-force-delete cur-file locked)
 146           (setq count (+ count 1))
 147           (message "%d cache(s) are expired." count))
 148         (setq deleted (+ deleted cur-size))
 149         (setq total (- total cur-size)))
 150       (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
 151                count deleted beginning))))
 152
 153 (defun elmo-cache-make-file-entity (filename path)
 154   (cons filename (elmo-get-last-accessed-time filename path)))
 155
 156 (defun elmo-cache-get-oldest-cache-file-entity (cache-file-list)
 157   (let ((cfl cache-file-list)
 158         flist firsts oldest-entity wonlist)
 159     (while cfl
 160       (setq flist (cdr (car cfl)))
 161       (setq firsts (append firsts (list
 162                                    (cons (car (car cfl))
 163                                          (car flist)))))
 164       (setq cfl (cdr cfl)))
 165 ;;; (prin1 firsts)
 166     (while firsts
 167       (if (and (not oldest-entity)
 168                (cdr (cdr (car firsts))))
 169           (setq oldest-entity (car firsts)))
 170       (if (and (cdr (cdr (car firsts)))
 171                (cdr (cdr oldest-entity))
 172                (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts)))))
 173           (setq oldest-entity (car firsts)))
 174       (setq firsts (cdr firsts)))
 175     (setq wonlist (assoc (car oldest-entity) cache-file-list))
 176     (and wonlist
 177          (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist))))
 178     oldest-entity))
 179
 180 (defun elmo-cache-get-sorted-cache-file-list ()
 181   (let ((dirs (directory-files
 182                (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
 183                t "^[^\\.]"))
 184         (i 0) num
 185         elist
 186         ret-val)
 187     (setq num (length dirs))
 188     (message "Collecting cache info...")
 189     (while dirs
 190       (setq elist (mapcar (lambda (x)
 191                             (elmo-cache-make-file-entity x (car dirs)))
 192                           (directory-files (car dirs) nil "^[^\\.]")))
 193       (setq ret-val (append ret-val
 194                             (list (cons
 195                                    (car dirs)
 196                                    (sort
 197                                     elist
 198                                     (lambda (x y)
 199                                       (< (cdr x)
 200                                          (cdr y))))))))
 201       (when (> num elmo-display-progress-threshold)
 202         (setq i (+ i 1))
 203         (elmo-display-progress
 204          'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
 205          (/ (* i 100) num)))
 206       (setq dirs (cdr dirs)))
 207     (message "Collecting cache info...done")
 208     ret-val))
 209
 210 (defun elmo-cache-expire-by-age (&optional days)
 211   (let ((age (or (and days (int-to-string days))
 212                  (and (interactive-p)
 213                       (read-from-minibuffer
 214                        (format "Enter days (%s): "
 215                                elmo-cache-expire-default-age)))
 216                  (int-to-string elmo-cache-expire-default-age)))
 217         (dirs (directory-files
 218                (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
 219                t "^[^\\.]"))
 220         (locked (elmo-dop-lock-list-load))
 221         (count 0)
 222         curtime)
 223     (if (string= age "")
 224         (setq age elmo-cache-expire-default-age)
 225       (setq age (string-to-int age)))
 226     (setq curtime (current-time))
 227     (setq curtime (+ (* (nth 0 curtime)
 228                         (float 65536)) (nth 1 curtime)))
 229     (while dirs
 230       (let ((files (directory-files (car dirs) t "^[^\\.]"))
 231             (limit-age (* age 86400)))
 232         (while files
 233           (when (> (- curtime (elmo-get-last-accessed-time (car files)))
 234                    limit-age)
 235             (when (elmo-cache-force-delete (car files) locked)
 236               (setq count (+ 1 count))
 237               (message "%d cache file(s) are expired." count)))
 238           (setq files (cdr files))))
 239       (setq dirs (cdr dirs)))))
 240
 241 (defun elmo-cache-save (msgid partial folder number &optional inbuf)
 242   "If PARTIAL is non-nil, save current buffer (or INBUF) as partial cache."
 243   (condition-case nil
 244       (save-excursion
 245         (let* ((path (if partial
 246                          (elmo-cache-get-path msgid folder number)
 247                        (elmo-cache-get-path msgid)))
 248                dir tmp-buf)
 249           (when path
 250             (setq dir (directory-file-name (file-name-directory path)))
 251             (if (not (file-exists-p dir))
 252                 (elmo-make-directory dir))
 253             (if inbuf (set-buffer inbuf))
 254             (goto-char (point-min))
 255             (as-binary-output-file (write-region (point-min) (point-max)
 256                                                  path nil 'no-msg)))))
 257     (error)))
 258
 259 (defun elmo-cache-exists-p (msgid &optional folder number)
 260   "Returns the path if the cache exists."
 261   (save-match-data
 262     (if msgid
 263         (let ((path (elmo-cache-get-path msgid)))
 264           (if (and path
 265                    (file-exists-p path))
 266               (if (and folder
 267                        (file-directory-p path))
 268                   (if (file-exists-p (setq path (expand-file-name
 269                                                  (format "%s@%s"
 270                                                          (or number "")
 271                                                          (elmo-safe-filename
 272                                                           folder))
 273                                                  path)))
 274                       path
 275                     )
 276                 ;; not directory.
 277                 path))))))
 278
 279 (defun elmo-cache-search-all (folder condition from-msgs)
 280   (let* ((number-alist (elmo-msgdb-number-load
 281                         (elmo-msgdb-expand-path folder)))
 282          (number-list (or from-msgs (mapcar 'car number-alist)))
 283          (num (length number-alist))
 284          cache-file
 285          ret-val
 286          case-fold-search msg
 287          percent i)
 288     (setq i 0)
 289     (while number-alist
 290       (if (and (memq (car (car number-alist)) number-list)
 291                (setq cache-file (elmo-cache-exists-p (cdr (car
 292                                                            number-alist))
 293                                                      folder
 294                                                      (car (car
 295                                                            number-alist))))
 296                (elmo-file-field-condition-match cache-file condition
 297                                                 (car (car number-alist))
 298                                                 number-list))
 299           (setq ret-val (append ret-val (list (caar number-alist)))))
 300       (when (> num elmo-display-progress-threshold)
 301         (setq i (1+ i))
 302         (setq percent (/ (* i 100) num))
 303         (elmo-display-progress
 304          'elmo-cache-search-all "Searching..."
 305          percent))
 306       (setq number-alist (cdr number-alist)))
 307     ret-val))
 308
 309 (defun elmo-cache-collect-sub-directories (init dir &optional recursively)
 310   "Collect subdirectories under DIR."
 311   (let ((dirs
 312          (delete (expand-file-name elmo-cache-dirname
 313                                    elmo-msgdb-dir)
 314                  (directory-files dir t "^[^\\.]")))
 315         ret-val)
 316     (setq dirs (elmo-delete-if (lambda (x) (not (file-directory-p x))) dirs))
 317     (setq ret-val (append init dirs))
 318     (while (and recursively dirs)
 319       (setq ret-val
 320             (elmo-cache-collect-sub-directories
 321              ret-val
 322              (car dirs) recursively))
 323       (setq dirs (cdr dirs)))
 324     ret-val))
 325
 326 (defun elmo-msgid-to-cache (msgid)
 327   (when (and msgid
 328              (string-match "<\\(.+\\)>$" msgid))
 329     (elmo-replace-msgid-as-filename (elmo-match-string 1 msgid))))
 330
 331 (defun elmo-cache-get-path (msgid &optional folder number)
 332   "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
 333   (if (setq msgid (elmo-msgid-to-cache msgid))
 334       (expand-file-name
 335        (expand-file-name
 336         (if folder
 337             (format "%s/%s/%s@%s"
 338                     (elmo-cache-get-path-subr msgid)
 339                     msgid
 340                     (or number "")
 341                     (elmo-safe-filename folder))
 342           (format "%s/%s"
 343                   (elmo-cache-get-path-subr msgid)
 344                   msgid))
 345         (expand-file-name elmo-cache-dirname
 346                           elmo-msgdb-dir)))))
 347
 348 (defsubst elmo-cache-get-path-subr (msgid)
 349   (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
 350         (clist (string-to-char-list msgid))
 351         (sum 0))
 352     (while clist
 353       (setq sum (+ sum (car clist)))
 354       (setq clist (cdr clist)))
 355     (format "%c%c"
 356             (nth (% (/ sum 16) 2) chars)
 357             (nth (% sum 16) chars))))
 358
 359
 360 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 361 ;; buffer cache module
 362
 363 (defconst elmo-buffer-cache-name " *elmo cache*")
 364
 365 (defvar elmo-buffer-cache nil
 366   "Message cache.  (old ... new) order alist.
 367 With association ((\"folder\" message \"message-id\") . cache-buffer).")
 368
 369 (defmacro elmo-buffer-cache-buffer-get (entry)
 370   (` (cdr (, entry))))
 371
 372 (defmacro elmo-buffer-cache-folder-get (entry)
 373   (` (car (car (, entry)))))
 374
 375 (defmacro elmo-buffer-cache-message-get (entry)
 376   (` (cdr (car (, entry)))))
 377
 378 (defmacro elmo-buffer-cache-entry-make (fld-msg-id buf)
 379   (` (cons (, fld-msg-id) (, buf))))
 380
 381 (defmacro elmo-buffer-cache-hit (fld-msg-id)
 382   "Return value assosiated with key."
 383   (` (elmo-buffer-cache-buffer-get
 384       (assoc (, fld-msg-id) elmo-buffer-cache))))
 385
 386 (defun elmo-buffer-cache-sort (entry)
 387   (let* ((pointer (cons nil elmo-buffer-cache))
 388          (top pointer))
 389     (while (cdr pointer)
 390       (if (equal (car (cdr pointer)) entry)
 391           (setcdr pointer (cdr (cdr pointer)))
 392         (setq pointer (cdr pointer))))
 393     (setcdr pointer (list entry))
 394     (setq elmo-buffer-cache (cdr top))))
 395
 396 (defun elmo-buffer-cache-add (fld-msg-id)
 397   "Adding (FLD-MSG-ID . buf) to the top of `elmo-buffer-cache'.
 398 Returning its cache buffer."
 399   (let ((len (length elmo-buffer-cache))
 400         (buf nil))
 401     (if (< len elmo-buffer-cache-size)
 402         (setq buf (get-buffer-create (format "%s%d" elmo-buffer-cache-name len)))
 403       (setq buf (elmo-buffer-cache-buffer-get (nth (1- len) elmo-buffer-cache)))
 404       (setcdr (nthcdr (- len 2) elmo-buffer-cache) nil))
 405     (save-excursion
 406       (set-buffer buf)
 407       (elmo-set-buffer-multibyte nil))
 408     (setq elmo-buffer-cache
 409           (cons (elmo-buffer-cache-entry-make fld-msg-id buf)
 410                 elmo-buffer-cache))
 411     buf))
 412
 413 (defun elmo-buffer-cache-delete ()
 414   "Delete the most recent cache entry."
 415   (let ((buf (elmo-buffer-cache-buffer-get (car elmo-buffer-cache))))
 416     (setq elmo-buffer-cache
 417           (nconc (cdr elmo-buffer-cache)
 418                  (list (elmo-buffer-cache-entry-make nil buf))))))
 419
 420 (defun elmo-buffer-cache-clean-up ()
 421   "A function to flush all decoded messages in cache list."
 422   (interactive)
 423   (let ((n 0) buf)
 424     (while (< n elmo-buffer-cache-size)
 425       (setq buf (concat elmo-buffer-cache-name (int-to-string n)))
 426       (elmo-kill-buffer buf)
 427       (setq n (1+ n))))
 428   (setq elmo-buffer-cache nil))
 429
 430 ;;
 431 ;; cache backend by Kenichi OKADA <okada@opaopa.org>
 432 ;;
 433
 434 (defsubst elmo-cache-get-folder-directory (spec)
 435   (if (file-name-absolute-p (nth 1 spec))
 436       (nth 1 spec) ; already full path.
 437     (expand-file-name (nth 1 spec)
 438                       (expand-file-name elmo-cache-dirname elmo-msgdb-dir))))
 439
 440 (defun elmo-cache-msgdb-expand-path (spec)
 441   (let ((fld-name (nth 1 spec)))
 442     (expand-file-name fld-name
 443                       (expand-file-name "internal/cache"
 444                                         elmo-msgdb-dir))))
 445
 446 (defun elmo-cache-number-to-filename (spec number)
 447   (let ((number-alist
 448          (elmo-cache-list-folder-subr spec nil t)))
 449     (elmo-msgid-to-cache
 450      (cdr (assq number number-alist)))))
 451
 452 (if (boundp 'nemacs-version)
 453     (defsubst elmo-cache-insert-header (file)
 454       "Insert the header of the article (Does not work on nemacs)."
 455       (as-binary-input-file
 456        (insert-file-contents file)))
 457   (defsubst elmo-cache-insert-header (file)
 458     "Insert the header of the article."
 459     (let ((beg 0)
 460           insert-file-contents-pre-hook ; To avoid autoconv-xmas...
 461           insert-file-contents-post-hook
 462           format-alist)
 463       (when (file-exists-p file)
 464         ;; Read until header separator is found.
 465         (while (and (eq elmo-localdir-header-chop-length
 466                         (nth 1
 467                              (as-binary-input-file
 468                               (insert-file-contents
 469                                file nil beg
 470                                (incf beg elmo-localdir-header-chop-length)))))
 471                     (prog1 (not (search-forward "\n\n" nil t))
 472                       (goto-char (point-max)))))))))
 473
 474 (defsubst elmo-cache-msgdb-create-overview-entity-from-file (number file)
 475   (save-excursion
 476     (let ((tmp-buffer (get-buffer-create " *ELMO Cache Temp*"))
 477           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 478           insert-file-contents-post-hook header-end
 479           (attrib (file-attributes file))
 480           ret-val size mtime)
 481       (set-buffer tmp-buffer)
 482       (erase-buffer)
 483       (if (not (file-exists-p file))
 484           ()
 485         (setq size (nth 7 attrib))
 486         (setq mtime (timezone-make-date-arpa-standard
 487                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 488         ;; insert header from file.
 489         (catch 'done
 490           (condition-case nil
 491               (elmo-cache-insert-header file)
 492             (error (throw 'done nil)))
 493           (goto-char (point-min))
 494           (setq header-end
 495                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 496                     (point)
 497                   (point-max)))
 498           (narrow-to-region (point-min) header-end)
 499           (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
 500           (kill-buffer tmp-buffer))
 501         ret-val))))
 502
 503 (defun elmo-cache-msgdb-create-as-numlist (spec numlist new-mark
 504                                                    already-mark seen-mark
 505                                                    important-mark seen-list)
 506   (when numlist
 507     (let ((dir (elmo-cache-get-folder-directory spec))
 508           (nalist (elmo-cache-list-folder-subr spec nil t))
 509           overview number-alist mark-alist entity message-id
 510           i percent len num seen gmark)
 511       (setq len (length numlist))
 512       (setq i 0)
 513       (message "Creating msgdb...")
 514       (while numlist
 515         (setq entity
 516               (elmo-cache-msgdb-create-overview-entity-from-file
 517                (car numlist)
 518                (expand-file-name
 519                 (elmo-msgid-to-cache
 520                  (setq message-id (cdr (assq (car numlist) nalist)))) dir)))
 521         (if (null entity)
 522             ()
 523           (setq num (elmo-msgdb-overview-entity-get-number entity))
 524           (setq overview
 525                 (elmo-msgdb-append-element
 526                  overview entity))
 527           (setq number-alist
 528                 (elmo-msgdb-number-add number-alist num message-id))
 529           (setq seen (member message-id seen-list))
 530           (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 531                               (if seen
 532                                   nil
 533                                 new-mark)))
 534               (setq mark-alist
 535                     (elmo-msgdb-mark-append
 536                      mark-alist
 537                      num
 538                      gmark))))
 539         (when (> len elmo-display-progress-threshold)
 540           (setq i (1+ i))
 541           (setq percent (/ (* i 100) len))
 542           (elmo-display-progress
 543            'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
 544            percent))
 545         (setq numlist (cdr numlist)))
 546       (message "Creating msgdb...done")
 547       (list overview number-alist mark-alist))))
 548
 549 (defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist)
 550
 551 (defun elmo-cache-list-folders (spec &optional hierarchy)
 552   (let ((folder (concat "'cache" (nth 1 spec))))
 553     (elmo-cache-list-folders-subr folder hierarchy)))
 554
 555 (defun elmo-cache-list-folders-subr (folder &optional hierarchy)
 556   (let ((case-fold-search t)
 557         folders curdir dirent relpath abspath attr
 558         subprefix subfolder)
 559     (condition-case ()
 560         (progn
 561           (setq curdir
 562                 (expand-file-name
 563                  (nth 1 (elmo-folder-get-spec folder))
 564                  (expand-file-name elmo-cache-dirname elmo-msgdb-dir)))
 565           (if (string-match "^[+=$!]$" folder) ; localdir, archive, localnews
 566               (setq subprefix folder)
 567             (setq subprefix (concat folder elmo-path-sep)))
 568             ;; include parent
 569             ;(setq folders (list folder)))
 570           (setq dirent (directory-files curdir nil "^[01][0-9A-F]$"))
 571           (catch 'done
 572            (while dirent
 573             (setq relpath (car dirent))
 574             (setq dirent (cdr dirent))
 575             (setq abspath (expand-file-name relpath curdir))
 576             (and
 577              (eq (nth 0 (setq attr (file-attributes abspath))) t)
 578              (setq subfolder (concat subprefix relpath))
 579              (setq folders (nconc folders (list subfolder))))))
 580           folders)
 581       (file-error folders))))
 582
 583 (defsubst elmo-cache-list-folder-subr (spec &optional nonsort nonalist)
 584   (let* ((dir (elmo-cache-get-folder-directory spec))
 585          (flist (mapcar 'file-name-nondirectory
 586                         (elmo-delete-if 'file-directory-p
 587                                         (directory-files
 588                                          dir t "^[^@]+@[^@]+$" t))))
 589          (folder (concat "'cache/" (nth 1 spec)))
 590          (number-alist (or (elmo-msgdb-number-load
 591                             (elmo-msgdb-expand-path folder))
 592                            (list nil)))
 593          nlist)
 594     (setq nlist
 595           (mapcar '(lambda (filename)
 596                      (elmo-cache-filename-to-number filename number-alist))
 597                   flist))
 598     (if nonalist
 599         number-alist
 600       (if nonsort
 601           (cons (or (elmo-max-of-list nlist) 0) (length nlist))
 602         (sort nlist '<)))))
 603
 604 (defsubst elmo-cache-filename-to-number (filename number-alist)
 605   (let* ((msgid (elmo-cache-to-msgid filename))
 606          number)
 607     (or (car (rassoc msgid number-alist))
 608         (prog1
 609             (setq number (+ (or (caar (last number-alist))
 610                                 0) 1))
 611           (if (car number-alist)
 612               (nconc number-alist
 613                      (list (cons number msgid)))
 614             (setcar number-alist (cons number msgid)))))))
 615
 616 (defun elmo-cache-append-msg (spec string message-id &optional msg no-see)
 617   (let ((dir (elmo-cache-get-folder-directory spec))
 618         (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
 619         filename)
 620     (save-excursion
 621       (set-buffer tmp-buffer)
 622       (erase-buffer)
 623       (setq filename (expand-file-name (elmo-msgid-to-cache message-id) dir))
 624       (unwind-protect
 625           (if (file-writable-p filename)
 626               (progn
 627                 (insert string)
 628                 (as-binary-output-file
 629                  (write-region (point-min) (point-max) filename nil 'no-msg))
 630                 t)
 631             nil)
 632         (kill-buffer tmp-buffer)))))
 633
 634 (defun elmo-cache-delete-msg (spec number locked)
 635   (let* ((dir (elmo-cache-get-folder-directory spec))
 636          (file (expand-file-name
 637                 (elmo-cache-number-to-filename spec number) dir)))
 638     ;; return nil if failed.
 639     (elmo-cache-force-delete file locked)))
 640
 641 (defun elmo-cache-read-msg (spec number outbuf &optional msgdb unread)
 642   (save-excursion
 643     (let* ((dir (elmo-cache-get-folder-directory spec))
 644            (file (expand-file-name
 645                   (elmo-cache-number-to-filename spec number) dir)))
 646       (set-buffer outbuf)
 647       (erase-buffer)
 648       (when (file-exists-p file)
 649         (as-binary-input-file (insert-file-contents file))
 650         (elmo-delete-cr-get-content-type)))))
 651
 652 (defun elmo-cache-delete-msgs (spec msgs)
 653   (let ((locked (elmo-dop-lock-list-load)))
 654     (not (memq nil
 655                (mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked))
 656                        msgs)))))
 657
 658 (defun elmo-cache-list-folder (spec)    ; called by elmo-cache-search()
 659   (let ((killed (and elmo-use-killed-list
 660                      (elmo-msgdb-killed-list-load
 661                       (elmo-msgdb-expand-path spec))))
 662         numbers)
 663     (setq numbers (elmo-cache-list-folder-subr spec))
 664     (elmo-living-messages numbers killed)))
 665
 666 (defun elmo-cache-max-of-folder (spec)
 667   (elmo-cache-list-folder-subr spec t))
 668
 669 (defun elmo-cache-check-validity (spec validity-file)
 670   t)
 671
 672 (defun elmo-cache-sync-validity (spec validity-file)
 673   t)
 674
 675 (defun elmo-cache-folder-exists-p (spec)
 676   (file-directory-p (elmo-cache-get-folder-directory spec)))
 677
 678 (defun elmo-cache-folder-creatable-p (spec)
 679   nil)
 680
 681 (defun elmo-cache-create-folder (spec)
 682   nil)
 683
 684 (defun elmo-cache-search (spec condition &optional from-msgs)
 685   (let* ((number-alist (elmo-cache-list-folder-subr spec nil t))
 686          (msgs (or from-msgs (mapcar 'car number-alist)))
 687          (num (length msgs))
 688          (i 0) case-fold-search ret-val)
 689     (while msgs
 690       (if (elmo-file-field-condition-match
 691            (expand-file-name
 692             (elmo-msgid-to-cache
 693              (cdr (assq (car msgs) number-alist)))
 694             (elmo-cache-get-folder-directory spec))
 695            condition
 696            (car msgs)
 697            msgs)
 698           (setq ret-val (cons (car msgs) ret-val)))
 699       (when (> num elmo-display-progress-threshold)
 700         (setq i (1+ i))
 701         (elmo-display-progress
 702          'elmo-cache-search "Searching..."
 703          (/ (* i 100) num)))
 704       (setq msgs (cdr msgs)))
 705     (nreverse ret-val)))
 706
 707 ;;; (localdir, maildir, localnews) -> cache
 708 (defun elmo-cache-copy-msgs (dst-spec msgs src-spec
 709                                       &optional loc-alist same-number)
 710   (let ((dst-dir
 711          (elmo-cache-get-folder-directory dst-spec))
 712         (next-num (1+ (car (elmo-cache-list-folder-subr dst-spec t))))
 713         (number-alist
 714          (elmo-msgdb-number-load
 715           (elmo-msgdb-expand-path src-spec))))
 716     (if same-number (error "Not implemented"))
 717     (while msgs
 718       (elmo-copy-file
 719        ;; src file
 720        (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
 721        ;; dst file
 722        (expand-file-name
 723         (elmo-msgid-to-cache
 724          (cdr (assq (if same-number (car msgs) next-num) number-alist)))
 725         dst-dir))
 726       (if (and (setq msgs (cdr msgs))
 727                (not same-number))
 728           (setq next-num (1+ next-num))))
 729     t))
 730
 731 (defun elmo-cache-use-cache-p (spec number)
 732   nil)
 733
 734 (defun elmo-cache-local-file-p (spec number)
 735   t)
 736
 737 (defun elmo-cache-get-msg-filename (spec number &optional loc-alist)
 738   (expand-file-name
 739    (elmo-cache-number-to-filename spec number)
 740    (elmo-cache-get-folder-directory spec)))
 741
 742 (defalias 'elmo-cache-sync-number-alist
 743   'elmo-generic-sync-number-alist)
 744 (defalias 'elmo-cache-list-folder-unread
 745   'elmo-generic-list-folder-unread)
 746 (defalias 'elmo-cache-list-folder-important
 747   'elmo-generic-list-folder-important)
 748 (defalias 'elmo-cache-commit 'elmo-generic-commit)
 749 (defalias 'elmo-cache-folder-diff 'elmo-generic-folder-diff)
 750
 751 (require 'product)
 752 (product-provide (provide 'elmo-cache) (require 'elmo-version))
 753
 754 ;;; elmo-cache.el ends here