elmo/elmo-dop.el

   1 ;;; elmo-dop.el -- Modules for Disconnected Operations on ELMO.
   2
   3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7 ;; Time-stamp: <2000-04-07 09:41:13 teranisi>
   8
   9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31 ;;
  32
  33 (require 'elmo-vars)
  34 (require 'elmo-msgdb)
  35 (require 'elmo-util)
  36 (eval-when-compile
  37   (require 'elmo-imap4)
  38   (require 'elmo-localdir))
  39
  40 ;; global variable.
  41 (defvar elmo-dop-queue nil
  42   "A list of (folder-name function-to-be-called argument-list).
  43 Automatically loaded/saved.")
  44
  45 (defun elmo-dop-queue-append (folder function argument)
  46   (let ((operation (list (format "%s" folder) function argument)))
  47     (elmo-dop-queue-load)
  48     (unless (member operation elmo-dop-queue) ;; don't append same operation
  49       (setq elmo-dop-queue
  50             (append elmo-dop-queue
  51                     (list operation)))
  52       (elmo-dop-queue-save))))
  53
  54 (defun elmo-dop-queue-flush (&optional force)
  55   "Flush Disconnected operations.
  56 If optional argument FORCE is non-nil, try flushing all operation queues
  57 even an operation concerns the unplugged folder."
  58   (elmo-dop-queue-load) ; load cache.
  59   (elmo-dop-queue-merge)
  60   (let ((queue elmo-dop-queue)
  61         (count 0)
  62         len)
  63     (while queue
  64       (if (or force (elmo-folder-plugged-p (caar queue)))
  65           (setq count (1+ count)))
  66       (setq queue (cdr queue)))
  67     (when (> count 0)
  68       (if (elmo-y-or-n-p
  69            (format "%d pending operation(s) exists. Perform now?" count)
  70            (not elmo-dop-flush-confirm) t)
  71           (progn
  72             (message "")
  73             (sit-for 0)
  74             (let ((queue elmo-dop-queue)
  75                   (performed 0)
  76                   (i 0)
  77                   (num (length elmo-dop-queue))
  78                   folder func failure)
  79               (while queue
  80                 ;; now perform pending processes.
  81                 (setq failure nil)
  82                 (setq i (+ 1 i))
  83                 (message "Flushing queue....%d/%d." i num)
  84                 (condition-case err
  85                     (if (and (not force)
  86                              (not (elmo-folder-plugged-p (nth 0 (car queue)))))
  87                         (setq failure t)
  88                       (setq folder (nth 0 (car queue))
  89                             func (nth 1 (car queue)))
  90                       (cond
  91                        ((string= func "prefetch-msgs")
  92                         (elmo-prefetch-msgs
  93                          folder
  94                          (nth 2 (car queue)))) ;argunemt
  95                        ((string= func "append-operations")
  96                         (elmo-dop-flush-pending-append-operations
  97                          folder nil t))
  98                        (t
  99                         (elmo-call-func
 100                          folder
 101                          func
 102                          (nth 2 (car queue)) ;argunemt
 103                          ))))
 104                   (quit  (setq failure t))
 105                   (error (setq failure err)))
 106                 (if failure
 107                     ;; create-folder was failed.
 108                     (when (and (string= func "create-folder-maybe")
 109                                (elmo-y-or-n-p
 110                                 (format
 111                                  "Create folder %s failed. Abort creating?"
 112                                  folder)
 113                                 (not elmo-dop-flush-confirm) t))
 114                       (elmo-dop-save-pending-messages folder)
 115                       (setq elmo-dop-queue (delq (car queue) elmo-dop-queue)))
 116                   (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 117                   (setq performed (+ 1 performed)))
 118                 (setq queue (cdr queue)))
 119               (message "%d/%d operation(s) are performed successfully."
 120                        performed num)
 121               (sit-for 1) ;
 122               (elmo-dop-queue-save)))
 123         (if (elmo-y-or-n-p "Clear all pending operations?"
 124                            (not elmo-dop-flush-confirm) t)
 125             (let ((queue elmo-dop-queue))
 126               (while queue
 127                 (if (string= (nth 1 (car queue)) "append-operations")
 128                     (elmo-dop-append-list-save (nth 0 (car queue)) nil))
 129                 (setq queue (cdr queue)))
 130               (setq elmo-dop-queue nil)
 131               (message "All pending operations are cleared.")
 132               (elmo-dop-queue-save))
 133           (message "")))
 134       count)))
 135
 136 (defconst elmo-dop-merge-funcs
 137   '("delete-msgids"
 138     "prefetch-msgs"
 139     "unmark-important"
 140     "mark-as-important"
 141     "mark-as-read"
 142     "mark-as-unread"))
 143
 144 (defun elmo-dop-queue-merge ()
 145   (let ((queue elmo-dop-queue)
 146         new-queue match-queue que)
 147     (while (setq que (car queue))
 148       (if (and
 149            (member (cadr que) elmo-dop-merge-funcs)
 150            (setq match-queue
 151                  (car (delete nil
 152                               (mapcar '(lambda (new-queue)
 153                                          (if (and
 154                                               (string= (car que) (car new-queue))
 155                                               (string= (cadr que) (cadr new-queue)))
 156                                              new-queue))
 157                                       new-queue)))))
 158           (setcar (cddr match-queue)
 159                   (append (nth 2 match-queue) (nth 2 que)))
 160         (setq new-queue (append new-queue (list que))))
 161       (setq queue (cdr queue)))
 162     (setq elmo-dop-queue new-queue)))
 163
 164 (defun elmo-dop-queue-load ()
 165   (save-excursion
 166     (setq elmo-dop-queue
 167           (elmo-object-load
 168            (expand-file-name elmo-queue-filename
 169                              elmo-msgdb-dir)))))
 170
 171 (defun elmo-dop-queue-save ()
 172   (save-excursion
 173     (elmo-object-save
 174      (expand-file-name elmo-queue-filename
 175                        elmo-msgdb-dir)
 176      elmo-dop-queue)))
 177
 178 (defun elmo-dop-lock-message (message-id &optional lock-list)
 179   (let ((locked (or lock-list
 180                     (elmo-object-load
 181                      (expand-file-name
 182                       elmo-msgdb-lock-list-filename
 183                       elmo-msgdb-dir)))))
 184     (setq locked (cons message-id locked))
 185     (elmo-object-save
 186      (expand-file-name elmo-msgdb-lock-list-filename
 187                        elmo-msgdb-dir)
 188      locked)))
 189
 190 (defun elmo-dop-unlock-message (message-id &optional lock-list)
 191   (let ((locked (or lock-list
 192                     (elmo-object-load
 193                      (expand-file-name elmo-msgdb-lock-list-filename
 194                                        elmo-msgdb-dir)))))
 195     (setq locked (delete message-id locked))
 196     (elmo-object-save
 197      (expand-file-name elmo-msgdb-lock-list-filename
 198                        elmo-msgdb-dir)
 199      locked)))
 200
 201 (defun elmo-dop-lock-list-load ()
 202   (elmo-object-load
 203    (expand-file-name elmo-msgdb-lock-list-filename
 204                      elmo-msgdb-dir)))
 205
 206 (defun elmo-dop-lock-list-save (lock-list)
 207   (elmo-object-save
 208    (expand-file-name elmo-msgdb-lock-list-filename
 209                      elmo-msgdb-dir)
 210    lock-list))
 211
 212 (defun elmo-dop-append-list-load (folder &optional resume)
 213   (elmo-object-load
 214    (expand-file-name (if resume
 215                          elmo-msgdb-resume-list-filename
 216                        elmo-msgdb-append-list-filename)
 217                      (elmo-msgdb-expand-path folder))))
 218
 219 (defun elmo-dop-append-list-save (folder append-list &optional resume)
 220   (if append-list
 221       (elmo-object-save
 222        (expand-file-name (if resume
 223                              elmo-msgdb-resume-list-filename
 224                            elmo-msgdb-append-list-filename)
 225                          (elmo-msgdb-expand-path folder))
 226        append-list)
 227     (condition-case ()
 228         (delete-file (expand-file-name (if resume
 229                                            elmo-msgdb-resume-list-filename
 230                                          elmo-msgdb-append-list-filename)
 231                                        (elmo-msgdb-expand-path folder)))
 232       (error))))
 233
 234 (defun elmo-dop-deleting-numbers-to-msgids (alist numbers appended)
 235   "returns (new-appended . deleting-msgids)."
 236   (let (msgid deleting-msgids)
 237     (while numbers
 238       (setq msgid (cdr (assq (car numbers) alist)))
 239       (if (member msgid appended)
 240           (setq appended (delete msgid appended))
 241         (setq deleting-msgids (append deleting-msgids (list msgid))))
 242       (setq numbers (cdr numbers)))
 243     (cons appended deleting-msgids)))
 244
 245 (defun elmo-dop-delete-msgs (folder msgs msgdb)
 246   (save-match-data
 247     (let ((folder-numbers (elmo-make-folder-numbers-list folder msgs))
 248           appended-deleting)
 249       (while folder-numbers
 250         (if (eq (elmo-folder-get-type (car (car folder-numbers)))
 251                 'imap4)
 252             (if elmo-enable-disconnected-operation
 253                 (progn
 254                   (setq appended-deleting
 255                         (elmo-dop-deleting-numbers-to-msgids
 256                          (elmo-msgdb-get-number-alist msgdb)
 257                          msgs ; virtual number
 258                          (elmo-dop-append-list-load folder)))
 259                   (if (cdr appended-deleting)
 260                       (elmo-dop-queue-append
 261                        (car (car folder-numbers)) ; real folder
 262                        "delete-msgids" ;; for secure removal.
 263                        (cdr appended-deleting)))
 264                   (elmo-dop-append-list-save folder (car appended-deleting)))
 265               (error "Unplugged"))
 266           ;; not imap4 folder...delete now!
 267           (elmo-call-func (car (car folder-numbers)) "delete-msgs"
 268                           (cdr (car folder-numbers))))
 269         (setq folder-numbers (cdr folder-numbers))))
 270     t))
 271
 272 (defun elmo-dop-prefetch-msgs (folder msgs)
 273   (save-match-data
 274     (elmo-dop-queue-append folder "prefetch-msgs" msgs)))
 275
 276 (defun elmo-dop-list-folder (folder)
 277   (if (or (memq (elmo-folder-get-type folder)
 278                 '(imap4 nntp pop3 filter pipe))
 279           (and (elmo-multi-p folder) (not (elmo-folder-local-p folder))))
 280       (if elmo-enable-disconnected-operation
 281           (let* ((number-alist (elmo-msgdb-number-load
 282                                 (elmo-msgdb-expand-path folder)))
 283                  (number-list (mapcar 'car number-alist))
 284                  (append-list (elmo-dop-append-list-load folder))
 285                  (append-num (length append-list))
 286                  alreadies
 287                  (i 0)
 288                  max-num)
 289             (while append-list
 290               (if (rassoc (car append-list) number-alist)
 291                   (setq alreadies (append alreadies
 292                                           (list (car append-list)))))
 293               (setq append-list (cdr append-list)))
 294             (setq append-num (- append-num (length alreadies)))
 295             (setq max-num
 296                   (or (nth (max (- (length number-list) 1) 0)
 297                            number-list) 0))
 298             (while (< i append-num)
 299               (setq number-list
 300                     (append number-list
 301                             (list (+ max-num i 1))))
 302               (setq i (+ 1 i)))
 303             number-list)
 304         (error "Unplugged"))
 305     ;; not imap4 folder...list folder
 306     (elmo-call-func folder "list-folder")))
 307
 308 (defun elmo-dop-count-appended (folder)
 309   (length (elmo-dop-append-list-load folder)))
 310
 311 (defun elmo-dop-call-func-on-msgs (folder func-name msgs msgdb)
 312   (let ((append-list (elmo-dop-append-list-load folder))
 313         (number-alist (elmo-msgdb-get-number-alist msgdb))
 314         matched)
 315     (if (eq (elmo-folder-get-type folder) 'imap4)
 316         (progn
 317           (while append-list
 318             (if (setq matched (car (rassoc (car append-list) number-alist)))
 319                 (setq msgs (delete matched msgs)))
 320             (setq append-list (cdr append-list)))
 321           (if msgs
 322               (elmo-dop-queue-append folder func-name msgs)))
 323       ;; maildir... XXX hard coding.....
 324       (if (not (featurep 'elmo-maildir))
 325           (require 'maildir))
 326       (funcall (intern (format "elmo-maildir-%s" func-name))
 327                (elmo-folder-get-spec folder)
 328                msgs msgdb))))
 329
 330 (defun elmo-dop-max-of-folder (folder)
 331   (if (eq (elmo-folder-get-type folder) 'imap4)
 332       (if elmo-enable-disconnected-operation
 333           (let* ((number-alist (elmo-msgdb-number-load
 334                                        (elmo-msgdb-expand-path folder)))
 335                  (number-list (mapcar 'car number-alist))
 336                  (append-list (elmo-dop-append-list-load folder))
 337                  (append-num (length append-list))
 338                  alreadies
 339                  (i 0)
 340                  max-num)
 341             (while append-list
 342               (if (rassoc (car append-list) number-alist)
 343                   (setq alreadies (append alreadies
 344                                           (list (car append-list)))))
 345               (setq append-list (cdr append-list)))
 346             (setq max-num
 347                   (or (nth (max (- (length number-list) 1) 0) number-list)
 348                       0))
 349             (cons (- (+ max-num append-num) (length alreadies))
 350                   (- (+ (length number-list) append-num) (length alreadies))))
 351         (error "Unplugged"))
 352     ;; not imap4 folder.
 353     (elmo-call-func folder "max-of-folder")))
 354
 355 (defun elmo-dop-save-pending-messages (folder)
 356   (message (format "Saving queued message in %s..." elmo-lost+found-folder))
 357   (let* ((append-list (elmo-dop-append-list-load folder))
 358          file-string)
 359     (while append-list
 360       (when (setq file-string (elmo-get-file-string  ; message string
 361                                (elmo-cache-get-path
 362                                 (car append-list))))
 363         (elmo-append-msg elmo-lost+found-folder file-string)
 364         (elmo-dop-unlock-message (car append-list)))
 365       (setq append-list (cdr append-list))
 366       (elmo-dop-append-list-save folder nil)))
 367   (message (format "Saving queued message in %s...done."
 368                    elmo-lost+found-folder)))
 369
 370 (defun elmo-dop-flush-pending-append-operations (folder &optional appends resume)
 371   (message "Appending queued messages...")
 372   (let* ((append-list (or appends
 373                           (elmo-dop-append-list-load folder)))
 374          (appendings append-list)
 375          (i 0)
 376          (num (length append-list))
 377          failure file-string)
 378     (when resume
 379       ;; Resume msgdb changed by elmo-dop-msgdb-create.
 380       (let* ((resumed-list (elmo-dop-append-list-load folder t))
 381              (number-alist (elmo-msgdb-number-load
 382                             (elmo-msgdb-expand-path folder)))
 383              (appendings append-list)
 384              pair dels)
 385         (while appendings
 386           (if (setq pair (rassoc (car appendings) number-alist))
 387               (setq resumed-list (append resumed-list
 388                                          (list (car appendings)))))
 389           (setq appendings (cdr appendings)))
 390         (elmo-dop-append-list-save folder resumed-list t)))
 391     (while appendings
 392       (setq failure nil)
 393       (setq file-string (elmo-get-file-string  ; message string
 394                          (elmo-cache-get-path
 395                           (car appendings))))
 396       (when file-string
 397         (condition-case ()
 398             (elmo-append-msg folder file-string (car appendings))
 399           (quit  (setq failure t))
 400           (error (setq failure t)))
 401         (setq i (+ 1 i))
 402         (message (format "Appending queued messages...%d" i))
 403         (if failure
 404             (elmo-append-msg elmo-lost+found-folder
 405                              file-string (car appendings))))
 406       (elmo-dop-unlock-message (car appendings))
 407       (setq appendings (cdr appendings)))
 408     ;; All pending append operation is flushed.
 409     (elmo-dop-append-list-save folder nil)
 410     (elmo-commit folder)
 411     (unless resume
 412       ;; delete '(folder "append-operations") in elmo-dop-queue.
 413       (let (elmo-dop-queue)
 414         (elmo-dop-queue-load)
 415         (setq elmo-dop-queue (delete (list folder "append-operations" nil)
 416                                      elmo-dop-queue))
 417         (elmo-dop-queue-save))))
 418   (message "Appending queued messages...done."))
 419
 420 (defun elmo-dop-folder-exists-p (folder)
 421   (if (and elmo-enable-disconnected-operation
 422            (eq (elmo-folder-get-type folder) 'imap4))
 423       (file-exists-p (elmo-msgdb-expand-path folder))
 424     (elmo-call-func folder "folder-exists-p")))
 425
 426 (defun elmo-dop-create-folder (folder)
 427   (if (eq (elmo-folder-get-type folder) 'imap4)
 428       (if elmo-enable-disconnected-operation
 429           (elmo-dop-queue-append folder "create-folder-maybe" nil)
 430         (error "Unplugged"))
 431     (elmo-call-func folder "create-folder")))
 432
 433 (defun elmo-dop-delete-folder (folder)
 434   (error "Unplugged"))
 435
 436 (defun elmo-dop-rename-folder (old-folder new-folder)
 437   (error "Unplugged"))
 438
 439 (defun elmo-dop-append-msg (folder string message-id &optional msg)
 440   (if elmo-enable-disconnected-operation
 441       (if message-id
 442           (progn
 443             (unless (elmo-cache-exists-p message-id)
 444               (elmo-set-work-buf
 445                (insert string)
 446                (elmo-cache-save message-id nil folder msg (current-buffer))))
 447             (let ((append-list (elmo-dop-append-list-load folder))
 448                   (number-alist (elmo-msgdb-number-load
 449                                  (elmo-msgdb-expand-path folder))))
 450               (when (and ; not in current folder.
 451                      (not (rassoc message-id number-alist))
 452                      (not (member message-id append-list)))
 453                 (setq append-list
 454                       (append append-list (list message-id)))
 455                 (elmo-dop-lock-message message-id)
 456                 (elmo-dop-append-list-save folder append-list)
 457                 (elmo-dop-queue-append folder "append-operations" nil))
 458               t))
 459         nil)
 460     (error "Unplugged")))
 461
 462 (defalias 'elmo-dop-msgdb-create 'elmo-dop-msgdb-create-as-numlist)
 463
 464 (defun elmo-dop-msgdb-create-as-numlist (folder numlist new-mark already-mark
 465                                                 seen-mark important-mark
 466                                                 seen-list)
 467   (if (or (eq (elmo-folder-get-type folder) 'imap4)
 468           (eq (elmo-folder-get-type folder) 'nntp))
 469       (if elmo-enable-disconnected-operation
 470           (let* ((num-alist (elmo-msgdb-number-load
 471                              (elmo-msgdb-expand-path folder)))
 472                  (number-list (mapcar 'car num-alist))
 473                  (ov (elmo-msgdb-overview-load
 474                       (elmo-msgdb-expand-path folder)))
 475                  (append-list (elmo-dop-append-list-load folder))
 476                  (num (length numlist))
 477                  (i 0)
 478                  overview number-alist mark-alist msgid ov-entity
 479                  max-num percent seen gmark)
 480             (setq max-num
 481                   (or (nth (max (- (length number-list) 1) 0) number-list)
 482                       0))
 483             (while numlist
 484               (if (setq msgid
 485                         (nth (+ (length append-list)
 486                                 (- (car numlist) max-num 1 num))
 487                              append-list))
 488                   (progn
 489                     (setq overview
 490                           (elmo-msgdb-append-element
 491                            overview
 492                            (elmo-localdir-msgdb-create-overview-entity-from-file
 493                             (car numlist)
 494                             (elmo-cache-get-path msgid))))
 495                     (setq number-alist
 496                           (elmo-msgdb-number-add number-alist
 497                                                  (car numlist) msgid))
 498                     (setq seen (member msgid seen-list))
 499                     (if (setq gmark
 500                               (or (elmo-msgdb-global-mark-get msgid)
 501                                   (if (elmo-cache-exists-p
 502                                        msgid
 503                                        folder
 504                                        (car number-alist))
 505                                       (if seen
 506                                           nil
 507                                         already-mark)
 508                                     (if seen
 509                                         seen-mark)
 510                                     new-mark)))
 511                         (setq mark-alist
 512                               (elmo-msgdb-mark-append
 513                                mark-alist (car numlist) gmark))))
 514
 515                 (when (setq ov-entity (assoc
 516                                        (cdr (assq (car numlist) num-alist))
 517                                        ov))
 518                   (setq overview
 519                         (elmo-msgdb-append-element
 520                          overview ov-entity))
 521                   (setq number-alist
 522                         (elmo-msgdb-number-add number-alist
 523                                                (car numlist)
 524                                                (car ov-entity)))
 525                   (setq seen (member ov-entity seen-list))
 526                   (if (setq gmark
 527                             (or (elmo-msgdb-global-mark-get (car ov-entity))
 528                                 (if (elmo-cache-exists-p
 529                                      msgid
 530                                      folder
 531                                      (car ov-entity))
 532                                     (if seen
 533                                         nil
 534                                       already-mark)
 535                                   (if seen
 536                                       seen-mark)
 537                                   new-mark)))
 538                       (setq mark-alist
 539                             (elmo-msgdb-mark-append
 540                              mark-alist (car numlist) gmark)))))
 541               (setq i (1+ i))
 542               (setq percent (/ (* i 100) num))
 543               (elmo-display-progress
 544                'elmo-dop-msgdb-create-as-numlist "Creating msgdb..."
 545                percent)
 546               (setq numlist (cdr numlist)))
 547             (list overview number-alist mark-alist))
 548         (error "Unplugged"))
 549     ;; not imap4 folder...
 550     (elmo-call-func folder "msgdb-create" numlist new-mark already-mark
 551                     seen-mark important-mark seen-list)))
 552
 553 (provide 'elmo-dop)
 554
 555 ;;; elmo-dop.el ends here