jabber-time.el

   1 ;; jabber-time.el - time reporting by JEP-0090
   2
   3 ;; Copyright (C) 2006 - 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
  26 (require 'time-date)
  27
  28 (add-to-list 'jabber-jid-info-menu
  29              (cons "Request time" 'jabber-get-time))
  30 (defun jabber-get-time (jc to)
  31   "Request time"
  32   (interactive (list (jabber-read-account)
  33                      (jabber-read-jid-completing "Request time of: "
  34                                                  nil nil nil 'full)))
  35   (jabber-send-iq jc to
  36                   "get"
  37                   '(query ((xmlns . "jabber:iq:time")))
  38                   #'jabber-process-data #'jabber-process-time
  39                   #'jabber-process-data "Time request failed"))
  40
  41 ;; called by jabber-process-data
  42 (defun jabber-process-time (jc xml-data)
  43   "Handle results from jabber:iq:time requests."
  44   (let ((query (jabber-iq-query xml-data)))
  45     (let ((display
  46            (car (jabber-xml-node-children
  47                  (car (jabber-xml-get-children
  48                        query 'display)))))
  49           (utc
  50            (car (jabber-xml-node-children
  51                  (car (jabber-xml-get-children
  52                        query 'utc)))))
  53           (tz
  54            (car (jabber-xml-node-children
  55                  (car (jabber-xml-get-children
  56                        query 'tz))))))
  57       (insert "Time:\t\t")
  58       (cond
  59        (display
  60         (insert display))
  61        (utc
  62         (insert (format-time-string "%Y-%m-%d %T" (jabber-parse-legacy-time utc)))))
  63       (insert "\n")
  64       (when tz
  65         (insert "Time zone:\t" tz "\n")))))
  66
  67 ;; the only difference between these two functions is the
  68 ;; jabber-read-jid-completing call.
  69 (defun jabber-get-last-online (jc to)
  70   "Request time since a user was last online, or uptime of a component."
  71   (interactive (list (jabber-read-account)
  72                      (jabber-read-jid-completing "Get last online for: "
  73                                                  nil nil nil 'bare-or-muc)))
  74   (jabber-send-iq jc to
  75                   "get"
  76                   '(query ((xmlns . "jabber:iq:last")))
  77                   #'jabber-process-data #'jabber-process-last
  78                   #'jabber-process-data "Last online request failed"))
  79
  80 (defun jabber-get-idle-time (jc to)
  81   "Request idle time of user."
  82   (interactive (list (jabber-read-account)
  83                      (jabber-read-jid-completing "Get idle time for: "
  84                                                  nil nil nil 'full)))
  85   (jabber-send-iq jc to
  86                   "get"
  87                   '(query ((xmlns . "jabber:iq:last")))
  88                   #'jabber-process-data #'jabber-process-last
  89                   #'jabber-process-data "Idle time request failed"))
  90
  91 (defun jabber-process-last (jc xml-data)
  92   "Handle resultts from jabber:iq:last requests."
  93   (let* ((from (jabber-xml-get-attribute xml-data 'from))
  94          (query (jabber-iq-query xml-data))
  95          (seconds (jabber-xml-get-attribute query 'seconds))
  96          (message (car (jabber-xml-node-children query))))
  97     (cond
  98      ((jabber-jid-resource from)
  99       ;; Full JID: idle time
 100       (insert (format "Idle for %s seconds" seconds) "\n"))
 101      ((jabber-jid-username from)
 102       ;; Bare JID with username: time since online
 103       (insert (format "Last online %s seconds ago" seconds) "\n")
 104       (let ((seconds (condition-case nil
 105                          (string-to-number seconds)
 106                        (error nil))))
 107         (when (numberp seconds)
 108           (insert "That is, at "
 109                   (format-time-string "%Y-%m-%d %T"
 110                                       (time-subtract (current-time)
 111                                                      (seconds-to-time seconds)))
 112                   "\n"))))
 113      (t
 114       ;; Only hostname: uptime
 115       (insert (format "Uptime: %s seconds" seconds) "\n")))))
 116
 117 (add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:time" 'jabber-return-time))
 118 (add-to-list 'jabber-advertised-features "jabber:iq:time")
 119 (defun jabber-return-time (jc xml-data)
 120   "Return client time as defined in JEP-0090.  Sender and ID are
 121 determined from the incoming packet passed in XML-DATA."
 122   (let ((to (jabber-xml-get-attribute xml-data 'from))
 123         (id (jabber-xml-get-attribute xml-data 'id)))
 124     (jabber-send-iq jc to "result"
 125                     `(query ((xmlns . "jabber:iq:time"))
 126                             ;; what is ``human-readable'' format?
 127                             ;; the same way as formating using by tkabber
 128                             (display () ,(format-time-string "%a %b %d %H:%M:%S %Z %Y"))
 129                             (tz () ,(format-time-string "%Z"))
 130                             (utc () ,(jabber-encode-legacy-time nil)))
 131                     nil nil nil nil
 132                     id)))
 133
 134 (provide 'jabber-time)
 135
 136 ;; arch-tag: 5396bfda-323a-11db-ac8d-000a95c2fcd0