jabber-history.el

   1 ;; jabber-history.el - recording message history
   2
   3 ;; Copyright (C) 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
   4 ;; Copyright (C) 2004 - Mathias Dahl
   5
   6 ;; This file is a part of jabber.el.
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program; if not, write to the Free Software
  20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22 ;;; Log format:
  23 ;; Each message is on one separate line, represented as a vector with
  24 ;; five elements.  The first element is time encoded according to
  25 ;; JEP-0082.  The second element is direction, "in" or "out".
  26 ;; The third element is the sender, "me" or a JID.  The fourth
  27 ;; element is the recipient.  The fifth element is the text
  28 ;; of the message.
  29
  30 ;; FIXME: when rotation is enabled, jabber-history-query won't look
  31 ;; for older history files if the current history file doesn't contain
  32 ;; enough backlog entries.
  33
  34 (require 'jabber-core)
  35 (require 'jabber-util)
  36 (require 'jabber-autoloads)
  37
  38 (defgroup jabber-history nil "Customization options for Emacs
  39 Jabber history files."
  40   :group 'jabber)
  41
  42 (defcustom jabber-history-enabled nil
  43   "Non-nil means message logging is enabled."
  44   :type 'boolean
  45   :group 'jabber-history)
  46
  47 (defcustom jabber-use-global-history t
  48   "Indicate whether Emacs Jabber should use a global file for
  49   store messages.  If non-nil, jabber-global-history-filename is
  50   used, otherwise, messages are stored in per-user files under
  51   the jabber-history-dir directory."
  52   :type 'boolean
  53   :group 'jabber-history)
  54
  55 (defcustom jabber-history-dir "~/.emacs-jabber"
  56   "Base directory where per-contact history files are stored.
  57   Used only when jabber-use-global-history is not true."
  58   :type 'directory
  59   :group 'jabber-history)
  60
  61 (defcustom jabber-global-history-filename "~/.jabber_global_message_log"
  62   "Global file where all messages are logged.  Used when
  63   jabber-use-global-history is non-nil."
  64   :type 'file
  65   :group 'jabber-history)
  66
  67 (defcustom jabber-history-enable-rotation nil
  68   "Whether history files should be renamed when reach
  69   jabber-history-size-limit kilobytes.  If nil, history files
  70   will grow indefinitely, otherwise they'll be renamed to
  71   <history-file>-<number>, where <number> is 1 or the smallest
  72   number after the last rotation."
  73   :type 'boolean
  74   :group 'jabber-history)
  75
  76 (defcustom jabber-history-size-limit 1024
  77   "Maximum history file size in kilobytes.  When history file
  78   reaches this limit, it is renamed to <history-file>-<number>,
  79   where <number> is 1 or the smallest number after the last
  80   rotation."
  81   :type 'integer
  82   :group 'jabber-history)
  83
  84
  85 (defun jabber-rotate-history-p (history-file)
  86   "Return true if HISTORY-FILE should be rotated."
  87   (when (and jabber-history-enable-rotation
  88              (file-exists-p history-file))
  89     (> (/ (nth 7 (file-attributes history-file)) 1024)
  90        jabber-history-size-limit)))
  91
  92 (defun jabber-history-rotate (history-file &optional try)
  93   "Rename HISTORY-FILE to HISTORY-FILE-TRY."
  94   (let ((suffix (number-to-string (or try 1))))
  95     (if (file-exists-p (concat history-file "-"  suffix))
  96         (jabber-history-rotate history-file (if try (1+ try) 1))
  97       (rename-file history-file (concat history-file "-" suffix)))))
  98
  99 (add-to-list 'jabber-message-chain 'jabber-message-history)
 100 (defun jabber-message-history (jc xml-data)
 101   "Log message to log file."
 102   (when (and (not jabber-use-global-history)
 103              (not (file-directory-p jabber-history-dir)))
 104     (make-directory jabber-history-dir))
 105   (if (and jabber-history-enabled (not (jabber-muc-message-p xml-data)))
 106       (let ((from (jabber-xml-get-attribute xml-data 'from))
 107             (text (car (jabber-xml-node-children
 108                         (car (jabber-xml-get-children xml-data 'body)))))
 109             (timestamp (car (delq nil (mapcar 'jabber-x-delay (jabber-xml-get-children xml-data 'x))))))
 110         (when (and from text)
 111           (jabber-history-log-message "in" from nil text timestamp)))))
 112
 113 (add-hook 'jabber-chat-send-hooks 'jabber-history-send-hook)
 114
 115 (defun jabber-history-send-hook (body id)
 116   "Log outgoing message to log file."
 117   (when (and (not jabber-use-global-history)
 118              (not (file-directory-p jabber-history-dir)))
 119     (make-directory jabber-history-dir))
 120   ;; This function is called from a chat buffer, so jabber-chatting-with
 121   ;; contains the desired value.
 122   (if jabber-history-enabled
 123       (jabber-history-log-message "out" nil jabber-chatting-with body (current-time))))
 124
 125 (defun jabber-history-filename (contact)
 126   "Return a history filename for CONTACT if the per-user file
 127   loggin strategy is used or the global history filename."
 128   (if jabber-use-global-history
 129       jabber-global-history-filename
 130     ;; jabber-jid-symbol is the best canonicalization we have.
 131     (concat jabber-history-dir
 132             "/" (symbol-name (jabber-jid-symbol contact)))))
 133
 134 (defun jabber-history-log-message (direction from to body timestamp)
 135   "Log a message"
 136   (with-temp-buffer
 137     ;; Remove properties
 138     (set-text-properties 0 (length body) nil body)
 139     ;; Encode text as Lisp string - get decoding for free
 140     (setq body (prin1-to-string body))
 141     ;; Encode LF and CR
 142     (while (string-match "\n" body)
 143       (setq body (replace-match "\\n" nil t body nil)))
 144     (while (string-match "\r" body)
 145       (setq body (replace-match "\\r" nil t body nil)))
 146     (insert (format "[\"%s\" \"%s\" %s %s %s]\n"
 147                     (jabber-encode-time (or timestamp (current-time)))
 148                     (or direction
 149                         "in")
 150                     (or (when from
 151                           (prin1-to-string from))
 152                         "\"me\"")
 153                     (or (when to
 154                           (prin1-to-string to))
 155                         "\"me\"")
 156                     body))
 157     (let ((coding-system-for-write 'utf-8)
 158           (history-file (jabber-history-filename (or from to))))
 159       (when (and (not jabber-use-global-history)
 160                  (not (file-directory-p jabber-history-dir)))
 161         (make-directory jabber-history-dir))
 162       (when (jabber-rotate-history-p history-file)
 163         (jabber-history-rotate history-file))
 164       (condition-case e
 165           (write-region (point-min) (point-max) history-file t 'quiet)
 166         (error
 167          (message "Unable to write history: %s" (error-message-string e)))))))
 168
 169 (defun jabber-history-query (start-time
 170                              end-time
 171                              number
 172                              direction
 173                              jid-regexp
 174                              history-file)
 175   "Return a list of vectors, one for each message matching the criteria.
 176 START-TIME and END-TIME are floats as obtained from `float-time'.
 177 Either or both may be nil, meaning no restriction.
 178 NUMBER is the maximum number of messages to return, or t for
 179 unlimited.
 180 DIRECTION is either \"in\" or \"out\", or t for no limit on direction.
 181 JID-REGEXP is a regexp which must match the JID.
 182 HISTORY-FILE is the file in which to search.
 183
 184 Currently jabber-history-query performs a linear search from the end
 185 of the log file."
 186   (when (file-readable-p history-file)
 187     (with-temp-buffer
 188       (let ((coding-system-for-read 'utf-8))
 189         (if jabber-use-global-history
 190             (insert-file-contents history-file)
 191           (let* ((lines-collected nil)
 192                 (matched-files (directory-files jabber-history-dir t (file-name-nondirectory history-file)))
 193                 (matched-files (cons (car matched-files) (sort (cdr matched-files) 'string>-numerical))))
 194             (while (not lines-collected)
 195               (if (null matched-files)
 196                   (setq lines-collected t)
 197                 (let ((file (pop matched-files)))
 198                   (progn
 199                     (insert-file-contents file)
 200                     (if (>= (count-lines (point-min) (point-max)) number)
 201                         (setq lines-collected t)))))))))
 202       (let (collected current-line)
 203         (goto-char (point-max))
 204         (catch 'beginning-of-file
 205             (while (progn
 206                      (backward-sexp)
 207                      (setq current-line (car (read-from-string
 208                                               (buffer-substring
 209                                                (point)
 210                                                (save-excursion
 211                                                  (forward-sexp)
 212                                                  (point))))))
 213                      (and (or (null start-time)
 214                               (> (jabber-float-time (jabber-parse-time
 215                                                      (aref current-line 0)))
 216                                  start-time))
 217                           (or (eq number t)
 218                               (< (length collected) number))))
 219               (if (and (or (eq direction t)
 220                            (string= direction (aref current-line 1)))
 221                        (or (null end-time)
 222                            (> end-time (jabber-float-time (jabber-parse-time
 223                                                            (aref current-line 0)))))
 224                        (string-match
 225                         jid-regexp
 226                         (car
 227                          (remove "me"
 228                                  (list (aref current-line 2)
 229                                        (aref current-line 3))))))
 230                   (push current-line collected))
 231               (when (bobp)
 232                 (throw 'beginning-of-file nil))))
 233         collected))))
 234
 235 (defcustom jabber-backlog-days 3.0
 236   "Age limit on messages in chat buffer backlog, in days"
 237   :group 'jabber
 238   :type '(choice (number :tag "Number of days")
 239                  (const :tag "No limit" nil)))
 240
 241 (defcustom jabber-backlog-number 10
 242   "Maximum number of messages in chat buffer backlog"
 243   :group 'jabber
 244   :type 'integer)
 245
 246 (defun jabber-history-backlog (jid &optional before)
 247   "Fetch context from previous chats with JID.
 248 Return a list of history entries (vectors), limited by
 249 `jabber-backlog-days' and `jabber-backlog-number'.
 250 If BEFORE is non-nil, it should be a float-time after which
 251 no entries will be fetched.  `jabber-backlog-days' still
 252 applies, though."
 253   (jabber-history-query
 254    (and jabber-backlog-days
 255         (- (jabber-float-time) (* jabber-backlog-days 86400.0)))
 256    before
 257    jabber-backlog-number
 258    t                                    ; both incoming and outgoing
 259    (concat "^" (regexp-quote (jabber-jid-user jid)) "\\(/.*\\)?$")
 260    (jabber-history-filename jid)))
 261
 262 (defun jabber-history-move-to-per-user ()
 263   "Migrate global history to per-user files."
 264   (interactive)
 265   (when (file-directory-p jabber-history-dir)
 266     (error "Per-user history directory already exists"))
 267   (make-directory jabber-history-dir)
 268   (let ((jabber-use-global-history nil))
 269     (with-temp-buffer
 270       (let ((coding-system-for-read 'utf-8))
 271         (insert-file-contents jabber-global-history-filename))
 272       (let ((progress-reporter
 273              (when (fboundp 'make-progress-reporter)
 274                (make-progress-reporter "Migrating history..."
 275                                        (point-min) (point-max))))
 276             ;;(file-table (make-hash-table :test 'equal))
 277             ;; Keep track of blocks of entries pertaining to the same JID.
 278             current-jid jid-start)
 279         (while (not (eobp))
 280           (let* ((start (point))
 281                  (end (progn (forward-line) (point)))
 282                  (line (buffer-substring start end))
 283                  (parsed (car (read-from-string line)))
 284                  (jid (if (string= (aref parsed 2) "me")
 285                           (aref parsed 3)
 286                         (aref parsed 2))))
 287             ;; Whenever there is a change in JID...
 288             (when (not (equal jid current-jid))
 289               (when current-jid
 290                 ;; ...save data for previous JID...
 291                 (let ((history-file (jabber-history-filename current-jid)))
 292                   (write-region jid-start start history-file t 'quiet)))
 293               ;; ...and switch to new JID.
 294               (setq current-jid jid)
 295               (setq jid-start start))
 296             (when (fboundp 'progress-reporter-update)
 297               (progress-reporter-update progress-reporter (point)))))
 298         ;; Finally, save the last block, if any.
 299         (when current-jid
 300           (let ((history-file (jabber-history-filename current-jid)))
 301             (write-region jid-start (point-max) history-file t 'quiet))))))
 302   (message "Done.  Please change `jabber-use-global-history' now."))
 303
 304 (provide 'jabber-history)
 305
 306 ;; arch-tag: 0AA0C235-3FC0-11D9-9FE7-000A95C2FCD0