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