jabber-time.el

   1 ;; jabber-time.el - time reporting by XEP-0012, XEP-0090, XEP-0202
   2
   3 ;; Copyright (C) 2006, 2010 - Kirill A. Kroinskiy - catap@catap.ru
   4 ;; Copyright (C) 2006 - Magnus Henoch - mange@freemail.hu
   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 GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  21 ;; Boston, MA 02110-1301, USA.
  22
  23 (require 'jabber-iq)
  24 (require 'jabber-util)
  25 (require 'jabber-autoaway)
  26
  27 (require 'time-date)
  28
  29 (add-to-list 'jabber-jid-info-menu (cons "Request time" 'jabber-get-time))
  30
  31 (defun jabber-get-time (jc to)
  32   "Request time"
  33   (interactive (list (jabber-read-account)
  34                      (jabber-read-jid-completing "Request time of: "
  35                                                  nil nil nil 'full t)))
  36
  37   (jabber-send-iq jc to "get"
  38                   '(query ((xmlns . "urn:xmpp:time")))
  39                   'jabber-silent-process-data 'jabber-process-time
  40                   'jabber-silent-process-data
  41                   (lambda (jc xml-data)
  42                     (let ((from (jabber-xml-get-attribute xml-data 'from)))
  43                       (jabber-get-legacy-time jc from)))))
  44
  45 (defun jabber-get-legacy-time (jc to)
  46   "Request legacy time"
  47   (interactive (list (jabber-read-account)
  48                      (jabber-read-jid-completing "Request time of: "
  49                                                  nil nil nil 'full t)))
  50
  51   (jabber-send-iq jc to
  52                   "get"
  53                   '(query ((xmlns . "jabber:iq:time")))
  54                   'jabber-silent-process-data 'jabber-process-legacy-time
  55                   'jabber-silent-process-data "Time request failed"))
  56
  57
  58 ;; called by jabber-process-data
  59 (defun jabber-process-time (jc xml-data)
  60   "Handle results from urn:xmpp:time requests."
  61   (let* ((from (jabber-xml-get-attribute xml-data 'from))
  62          (time (or (car (jabber-xml-get-children xml-data 'time))
  63                    ;; adium response of qeury
  64                    (car (jabber-xml-get-children xml-data 'query))))
  65          (tzo (car (jabber-xml-node-children
  66                     (car (jabber-xml-get-children time 'tzo)))))
  67          (utc (car (jabber-xml-node-children
  68                     (car (jabber-xml-get-children time 'utc))))))
  69     (when (and utc tzo)
  70       (format "%s has time: %s %s"
  71               from (format-time-string "%Y-%m-%d %T" (jabber-parse-time utc)) tzo))))
  72
  73 (defun jabber-process-legacy-time (jc xml-data)
  74   "Handle results from jabber:iq:time requests."
  75   (let* ((from (jabber-xml-get-attribute xml-data 'from))
  76          (query (jabber-iq-query xml-data))
  77          (display
  78           (car (jabber-xml-node-children
  79                 (car (jabber-xml-get-children
  80                       query 'display)))))
  81          (utc
  82           (car (jabber-xml-node-children
  83                 (car (jabber-xml-get-children
  84                       query 'utc)))))
  85          (tz
  86           (car (jabber-xml-node-children
  87                 (car (jabber-xml-get-children
  88                       query 'tz))))))
  89     (format "%s has time: %s" from
  90            (cond
  91             (display display)
  92             (utc
  93              (concat
  94               (format-time-string "%Y-%m-%d %T" (jabber-parse-legacy-time utc))
  95               (when tz
  96                 (concat " " tz))))))))
  97
  98 ;; the only difference between these two functions is the
  99 ;; jabber-read-jid-completing call.
 100 (defun jabber-get-last-online (jc to)
 101   "Request time since a user was last online, or uptime of a component."
 102   (interactive (list (jabber-read-account)
 103                      (jabber-read-jid-completing "Get last online for: "
 104                                                  nil nil nil 'bare-or-muc)))
 105   (jabber-send-iq jc to
 106                   "get"
 107                   '(query ((xmlns . "jabber:iq:last")))
 108                   #'jabber-silent-process-data #'jabber-process-last
 109                   #'jabber-silent-process-data "Last online request failed"))
 110
 111 (defun jabber-get-idle-time (jc to)
 112   "Request idle time of user."
 113   (interactive (list (jabber-read-account)
 114                      (jabber-read-jid-completing "Get idle time for: "
 115                                                  nil nil nil 'full t)))
 116   (jabber-send-iq jc to
 117                   "get"
 118                   '(query ((xmlns . "jabber:iq:last")))
 119                   #'jabber-silent-process-data #'jabber-process-last
 120                   #'jabber-silent-process-data "Idle time request failed"))
 121
 122 (defun jabber-process-last (jc xml-data)
 123   "Handle resultts from jabber:iq:last requests."
 124   (let* ((from (jabber-xml-get-attribute xml-data 'from))
 125          (query (jabber-iq-query xml-data))
 126          (seconds (jabber-xml-get-attribute query 'seconds))
 127          (message (car (jabber-xml-node-children query))))
 128     (cond
 129      ((jabber-jid-resource from)
 130       ;; Full JID: idle time
 131       (format "%s idle for %s seconds" from seconds))
 132      ((jabber-jid-username from)
 133       ;; Bare JID with username: time since online
 134       (concat
 135        (format "%s last online %s seconds ago" from seconds)
 136        (let ((seconds (condition-case nil
 137                           (string-to-number seconds)
 138                         (error nil))))
 139          (when (numberp seconds)
 140            "That is, at "
 141            (format-time-string "%Y-%m-%d %T"
 142                                (time-subtract (current-time)
 143                                               (seconds-to-time seconds)))
 144            "\n"))))
 145      (t
 146       ;; Only hostname: uptime
 147       (format "%s uptime: %s seconds" from seconds)))))
 148
 149 (add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:time" 'jabber-return-legacy-time))
 150 (add-to-list 'jabber-advertised-features "jabber:iq:time")
 151
 152 (defun jabber-return-legacy-time (jc xml-data)
 153   "Return client time as defined in XEP-0090.  Sender and ID are
 154 determined from the incoming packet passed in XML-DATA."
 155   (let ((to (jabber-xml-get-attribute xml-data 'from))
 156         (id (jabber-xml-get-attribute xml-data 'id)))
 157     (jabber-send-iq jc to "result"
 158                     `(query ((xmlns . "jabber:iq:time"))
 159                             ;; what is ``human-readable'' format?
 160                             ;; the same way as formating using by tkabber
 161                             (display () ,(format-time-string "%a %b %d %H:%M:%S %Z %Y"))
 162                             (tz () ,(format-time-string "%Z"))
 163                             (utc () ,(jabber-encode-legacy-time nil)))
 164                     nil nil nil nil
 165                     id)))
 166
 167 (add-to-list 'jabber-iq-get-xmlns-alist (cons "urn:xmpp:time" 'jabber-return-time))
 168 (add-to-list 'jabber-advertised-features "urn:xmpp:time")
 169
 170 (defun jabber-return-time (jc xml-data)
 171   "Return client time as defined in XEP-0202.  Sender and ID are
 172 determined from the incoming packet passed in XML-DATA."
 173   (let ((to (jabber-xml-get-attribute xml-data 'from))
 174         (id (jabber-xml-get-attribute xml-data 'id)))
 175     (jabber-send-iq jc to "result"
 176                     `(time ((xmlns . "urn:xmpp:time"))
 177                            (utc () ,(jabber-encode-time nil))
 178                            (tzo () ,(jabber-encode-timezone)))
 179                     nil nil nil nil
 180                     id)))
 181
 182 (add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:last" 'jabber-return-last))
 183 (add-to-list 'jabber-advertised-features "jabber:iq:last")
 184
 185 (defun jabber-return-last (jc xml-data)
 186   (let ((to (jabber-xml-get-attribute xml-data 'from))
 187         (id (jabber-xml-get-attribute xml-data 'id)))
 188     (jabber-send-iq jc to "result"
 189                     `(time ((xmlns . "jabber:iq:last")
 190                             ;; XEP-0012 specifies that this is an integer.
 191                             (seconds . ,(number-to-string
 192                                          (floor (jabber-autoaway-get-idle-time))))))
 193                     nil nil nil nil
 194                     id)))
 195
 196
 197 (provide 'jabber-time)
 198
 199 ;; arch-tag: 5396bfda-323a-11db-ac8d-000a95c2fcd0