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