elmo/modb-entity.el

   1 ;;; modb-entity.el --- Message Entity Interface.
   2
   3 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;;      Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
   7 ;; Keywords: mail, net news
   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 ;; Message entity handling.
  30
  31 ;;; Code:
  32
  33 (eval-when-compile (require 'cl))
  34
  35 (require 'luna)
  36 (require 'elmo-vars)
  37 (require 'elmo-util)
  38
  39 (eval-and-compile (luna-define-class modb-entity-handler))
  40
  41 (defcustom modb-entity-default-handler 'modb-legacy-entity-handler
  42   "Default entity handler."
  43   :type 'symbol
  44   :group 'elmo)
  45
  46 (defvar modb-entity-default-cache-internal nil)
  47
  48 (defun elmo-message-entity-handler (&optional entity)
  49   "Get modb entity handler instance which corresponds to the ENTITY."
  50   (if (and entity
  51            (car-safe entity)
  52            (not (stringp (car entity))))
  53       (car entity)
  54     (or modb-entity-default-cache-internal
  55         (setq modb-entity-default-cache-internal
  56               (luna-make-entity modb-entity-default-handler)))))
  57
  58 (luna-define-generic elmo-msgdb-make-message-entity (handler &rest args)
  59   "Make a message entity using HANDLER.")
  60
  61 (luna-define-generic elmo-msgdb-message-entity-number (handler entity)
  62   "Number of the ENTITY.")
  63
  64 (luna-define-generic elmo-msgdb-message-entity-set-number (handler
  65                                                            entity number)
  66   "Set number of the ENTITY.")
  67
  68 (luna-define-generic elmo-msgdb-message-entity-field (handler
  69                                                       entity field
  70                                                       &optional decode)
  71   "Retrieve field value of the message entity.
  72 HANDLER is the message entity handler.
  73 ENTITY is the message entity structure.
  74 FIELD is a symbol of the field.
  75 If optional DECODE is no-nil, the field value is decoded.")
  76
  77 (luna-define-generic elmo-msgdb-message-entity-set-field (handler
  78                                                           entity field value)
  79   "Set the field value of the message entity.
  80 HANDLER is the message entity handler.
  81 ENTITY is the message entity structure.
  82 FIELD is a symbol of the field.
  83 VALUE is the field value to set.")
  84
  85 (luna-define-generic elmo-msgdb-copy-message-entity (handler entity)
  86   "Copy message entity.
  87 HANDLER is the message entity handler.
  88 ENTITY is the message entity structure.")
  89
  90 (luna-define-generic elmo-msgdb-create-message-entity-from-file (handler
  91                                                                  number
  92                                                                  file)
  93   "Create message entity from file.
  94 HANDLER is the message entity handler.
  95 NUMBER is the number of the newly created message entity.
  96 FILE is the message file.")
  97
  98 (luna-define-generic elmo-msgdb-create-message-entity-from-buffer (handler
  99                                                                    number
 100                                                                    &rest args)
 101   "Create message entity from current buffer.
 102 HANDLER is the message entity handler.
 103 NUMBER is the number of the newly created message entity.
 104 Rest of the ARGS is a plist of message entity field for initial value.
 105 Header region is supposed to be narrowed.")
 106
 107 ;; Transitional interface.
 108 (luna-define-generic elmo-msgdb-message-match-condition (handler
 109                                                          condition
 110                                                          entity
 111                                                          flags
 112                                                          numbers)
 113   "Return non-nil when the entity matches the condition.")
 114
 115 ;; Generic implementation.
 116 (luna-define-method elmo-msgdb-create-message-entity-from-file
 117   ((handler modb-entity-handler) number file)
 118   (let (insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 119         insert-file-contents-post-hook header-end
 120         (attrib (file-attributes file))
 121         ret-val size mtime)
 122     (with-temp-buffer
 123       (if (not (file-exists-p file))
 124           ()
 125         (setq size (nth 7 attrib))
 126         (setq mtime (timezone-make-date-arpa-standard
 127                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 128         ;; insert header from file.
 129         (catch 'done
 130           (condition-case nil
 131               (elmo-msgdb-insert-file-header file)
 132             (error (throw 'done nil)))
 133           (goto-char (point-min))
 134           (setq header-end
 135                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 136                     (point)
 137                   (point-max)))
 138           (narrow-to-region (point-min) header-end)
 139           (elmo-msgdb-create-message-entity-from-buffer
 140            handler number :size size :date mtime))))))
 141
 142 (luna-define-method elmo-msgdb-make-message-entity ((handler
 143                                                      modb-entity-handler)
 144                                                     args)
 145   (cons handler args))
 146
 147 (luna-define-method elmo-msgdb-message-entity-field ((handler
 148                                                      modb-entity-handler)
 149                                                      entity field
 150                                                      &optional decode)
 151   (plist-get (cdr entity) (intern (concat ":" (symbol-name field)))))
 152
 153 (luna-define-method elmo-msgdb-message-entity-number ((handler
 154                                                        modb-entity-handler)
 155                                                       entity)
 156   (plist-get (cdr entity) :number))
 157
 158 ;; Legacy implementation.
 159 (eval-and-compile (luna-define-class modb-legacy-entity-handler
 160                                      (modb-entity-handler)))
 161
 162 ;;
 163 ;; mime decode cache
 164 ;;
 165 (defvar elmo-msgdb-decoded-cache-hashtb nil)
 166 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
 167
 168 (defsubst elmo-msgdb-get-decoded-cache (string)
 169   (if elmo-use-decoded-cache
 170       (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
 171                         (setq elmo-msgdb-decoded-cache-hashtb
 172                               (elmo-make-hash 2048))))
 173             decoded)
 174         (or (elmo-get-hash-val string hashtb)
 175             (progn
 176               (elmo-set-hash-val
 177                string
 178                (setq decoded
 179                      (decode-mime-charset-string string elmo-mime-charset))
 180                hashtb)
 181               decoded)))
 182     (decode-mime-charset-string string elmo-mime-charset)))
 183
 184 (defsubst modb-legacy-make-message-entity (args)
 185   "Make an message entity."
 186   (cons (plist-get args :message-id)
 187         (vector (plist-get args :number)
 188                 (plist-get args :references)
 189                 (plist-get args :from)
 190                 (plist-get args :subject)
 191                 (plist-get args :date)
 192                 (plist-get args :to)
 193                 (plist-get args :cc)
 194                 (plist-get args :size)
 195                 (plist-get args :extra))))
 196
 197 (luna-define-method elmo-msgdb-make-message-entity
 198   ((handler modb-legacy-entity-handler) args)
 199   (modb-legacy-make-message-entity args))
 200
 201 (luna-define-method elmo-msgdb-create-message-entity-from-buffer
 202   ((handler modb-legacy-entity-handler) number args)
 203   (let ((extras elmo-msgdb-extra-fields)
 204         (default-mime-charset default-mime-charset)
 205         entity message-id references from subject to cc date
 206         extra field-body charset size)
 207     (save-excursion
 208       (setq entity (modb-legacy-make-message-entity args))
 209       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
 210       (setq message-id (elmo-msgdb-get-message-id-from-buffer))
 211       (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
 212            (setq charset (intern-soft charset))
 213            (setq default-mime-charset charset))
 214       (setq references
 215             (or (elmo-msgdb-get-last-message-id
 216                  (elmo-field-body "in-reply-to"))
 217                 (elmo-msgdb-get-last-message-id
 218                  (elmo-field-body "references")))
 219             from (elmo-replace-in-string
 220                   (elmo-mime-string (or (elmo-field-body "from")
 221                                         elmo-no-from))
 222                   "\t" " ")
 223             subject (elmo-replace-in-string
 224                      (elmo-mime-string (or (elmo-field-body "subject")
 225                                            elmo-no-subject))
 226                      "\t" " ")
 227             date (elmo-unfold-field-body "date")
 228             to   (mapconcat 'identity (elmo-multiple-field-body "to") ",")
 229             cc   (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
 230       (unless (elmo-msgdb-message-entity-field handler entity 'size)
 231         (if (setq size (elmo-field-body "content-length"))
 232             (setq size (string-to-int size))
 233           (setq size 0)))
 234       (while extras
 235         (if (setq field-body (elmo-field-body (car extras)))
 236             (elmo-msgdb-message-entity-set-field
 237              handler entity (intern (downcase (car extras))) field-body))
 238         (setq extras (cdr extras)))
 239       (dolist (field '(message-id number references from subject
 240                                   date to cc size))
 241         (when (symbol-value field)
 242           (elmo-msgdb-message-entity-set-field
 243            handler entity field (symbol-value field))))
 244       entity)))
 245
 246 (luna-define-method elmo-msgdb-message-entity-number
 247   ((handler modb-legacy-entity-handler) entity)
 248   (and entity (aref (cdr entity) 0)))
 249
 250 (luna-define-method elmo-msgdb-message-entity-set-number
 251   ((handler modb-legacy-entity-handler) entity number)
 252   (and entity (aset (cdr entity) 0 number))
 253   entity)
 254
 255 (luna-define-method elmo-msgdb-message-entity-field
 256   ((handler modb-legacy-entity-handler) entity field &optional decode)
 257   (and entity
 258        (let ((field-value
 259               (case field
 260                 (to (aref (cdr entity) 5))
 261                 (cc (aref (cdr entity) 6))
 262                 (date (aref (cdr entity) 4))
 263                 (subject (aref (cdr entity) 3))
 264                 (from (aref (cdr entity) 2))
 265                 (message-id (car entity))
 266                 (references (aref (cdr entity) 1))
 267                 (size (aref (cdr entity) 7))
 268                 (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
 269          (if (and decode (memq field '(from subject)))
 270              (elmo-msgdb-get-decoded-cache field-value)
 271            field-value))))
 272
 273 (luna-define-method elmo-msgdb-message-entity-set-field
 274   ((handler modb-legacy-entity-handler) entity field value)
 275   (and entity
 276        (case field
 277          (number (aset (cdr entity) 0 value))
 278          (to (aset (cdr entity) 5 value))
 279          (cc (aset (cdr entity) 6 value))
 280          (date (aset (cdr entity) 4 value))
 281          (subject (aset (cdr entity) 3 value))
 282          (from (aset (cdr entity) 2 value))
 283          (message-id (setcar entity value))
 284          (references (aset (cdr entity) 1 value))
 285          (size (aset (cdr entity) 7 value))
 286          (t
 287           (let ((extras (and entity (aref (cdr entity) 8)))
 288                 extra)
 289             (if (setq extra (assoc (symbol-name field) extras))
 290                 (setcdr extra value)
 291               (aset (cdr entity) 8 (cons (cons (symbol-name field)
 292                                                value) extras))))))))
 293
 294 (luna-define-method elmo-msgdb-copy-message-entity
 295   ((handler modb-legacy-entity-handler) entity)
 296   (cons (car entity)
 297         (copy-sequence (cdr entity))))
 298
 299 (luna-define-method elmo-msgdb-message-match-condition
 300   ((handler modb-legacy-entity-handler) condition entity flags numbers)
 301   (cond
 302    ((vectorp condition)
 303     (elmo-msgdb-match-condition-primitive handler condition
 304                                           entity flags numbers))
 305    ((eq (car condition) 'and)
 306     (let ((lhs (elmo-msgdb-message-match-condition handler
 307                                                    (nth 1 condition)
 308                                                    entity flags numbers)))
 309       (cond
 310        ((elmo-filter-condition-p lhs)
 311         (let ((rhs (elmo-msgdb-message-match-condition
 312                     handler (nth 2 condition) entity flags numbers)))
 313           (cond ((elmo-filter-condition-p rhs)
 314                  (list 'and lhs rhs))
 315                 (rhs
 316                  lhs))))
 317        (lhs
 318         (elmo-msgdb-message-match-condition handler (nth 2 condition)
 319                                             entity flags numbers)))))
 320    ((eq (car condition) 'or)
 321     (let ((lhs (elmo-msgdb-message-match-condition handler (nth 1 condition)
 322                                                    entity flags numbers)))
 323       (cond
 324        ((elmo-filter-condition-p lhs)
 325         (let ((rhs (elmo-msgdb-message-match-condition handler
 326                                                        (nth 2 condition)
 327                                                        entity flags numbers)))
 328           (cond ((elmo-filter-condition-p rhs)
 329                  (list 'or lhs rhs))
 330                 (rhs
 331                  t)
 332                 (t
 333                  lhs))))
 334        (lhs
 335         t)
 336        (t
 337         (elmo-msgdb-message-match-condition handler
 338                                              (nth 2 condition)
 339                                              entity flags numbers)))))))
 340
 341 ;;
 342 (defun elmo-msgdb-match-condition-primitive (handler
 343                                              condition
 344                                              entity
 345                                              flags
 346                                              numbers)
 347   (catch 'unresolved
 348     (let ((key (elmo-filter-key condition))
 349           (case-fold-search t)
 350           result)
 351       (cond
 352        ((string= key "last")
 353         (setq result (<= (length (memq
 354                                   (elmo-msgdb-message-entity-number
 355                                    handler entity)
 356                                   numbers))
 357                          (string-to-int (elmo-filter-value condition)))))
 358        ((string= key "first")
 359         (setq result (< (-
 360                          (length numbers)
 361                          (length (memq
 362                                   (elmo-msgdb-message-entity-number
 363                                    handler entity)
 364                                   numbers)))
 365                         (string-to-int (elmo-filter-value condition)))))
 366        ((string= key "flag")
 367         (setq result
 368               (cond
 369                ((string= (elmo-filter-value condition) "any")
 370                 (or (memq 'important flags)
 371                     (memq 'answered flags)
 372                     (memq 'unread flags)))
 373                ((string= (elmo-filter-value condition) "digest")
 374                 (or (memq 'important flags)
 375                     (memq 'unread flags)))
 376                ((string= (elmo-filter-value condition) "unread")
 377                 (memq 'unread flags))
 378                ((string= (elmo-filter-value condition) "important")
 379                 (memq 'important flags))
 380                ((string= (elmo-filter-value condition) "answered")
 381                 (memq 'answered flags)))))
 382        ((string= key "from")
 383         (setq result (string-match
 384                       (elmo-filter-value condition)
 385                       (elmo-msgdb-message-entity-field
 386                        handler entity 'from t))))
 387        ((string= key "subject")
 388         (setq result (string-match
 389                       (elmo-filter-value condition)
 390                       (elmo-msgdb-message-entity-field
 391                        handler entity 'subject t))))
 392        ((string= key "to")
 393         (setq result (string-match
 394                       (elmo-filter-value condition)
 395                       (elmo-msgdb-message-entity-field
 396                        handler entity 'to))))
 397        ((string= key "cc")
 398         (setq result (string-match
 399                       (elmo-filter-value condition)
 400                       (elmo-msgdb-message-entity-field
 401                        handler entity 'cc))))
 402        ((or (string= key "since")
 403             (string= key "before"))
 404         (let ((field-date (elmo-date-make-sortable-string
 405                            (timezone-fix-time
 406                             (elmo-msgdb-message-entity-field
 407                              handler entity 'date)
 408                             (current-time-zone) nil)))
 409               (specified-date
 410                (elmo-date-make-sortable-string
 411                 (elmo-date-get-datevec
 412                  (elmo-filter-value condition)))))
 413           (setq result (if (string= key "since")
 414                            (or (string= specified-date field-date)
 415                                (string< specified-date field-date))
 416                          (string< field-date specified-date)))))
 417        ((member key elmo-msgdb-extra-fields)
 418         (let ((extval (elmo-msgdb-message-entity-field handler
 419                                                        entity
 420                                                        (intern key))))
 421           (when (stringp extval)
 422             (setq result (string-match
 423                           (elmo-filter-value condition)
 424                           extval)))))
 425        (t
 426         (throw 'unresolved condition)))
 427       (if (eq (elmo-filter-type condition) 'unmatch)
 428           (not result)
 429         result))))
 430
 431 (require 'product)
 432 (product-provide (provide 'modb-entity) (require 'elmo-version))
 433
 434 ;;; modb-entity.el ends here