elmo/elmo-dop.el

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