# ping.tcl --
#
#       This file is part of the XMPP library. It implements interface to
#       XMPP Ping (XEP-0199)
#
# Copyright (c) 2009-2010 Sergei Golovan <sgolovan@nes.ru>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAMER OF ALL WARRANTIES.
#
# $Id$

package provide xmpp::ping 0.1

namespace eval ::xmpp::ping {
    namespace export ping register unregister
}

# ::xmpp::ping::ping --
#
#       Send XMPP ping IQ request to a specified JID.
#
# Arguments:
#       xlib            XMPP token.
#       -to jid         (optional) JID to send ping request. If empty then
#                       the request is sent without 'to' attribute which
#                       means sending to own bare JID.
#       -timeout msecs  (optional) Timeout in milliseconds of waiting for
#                       answer.
#       -command cmd    (optional) Command to call back on receiving reply.
#
# Result:
#       ID of outgoing IQ.
#
# Side effects:
#       A ping packet is sent over the XMPP connection $xlib.

proc ::xmpp::ping::ping {xlib args} {
    set commands {}
    set newArgs {}
    foreach {key val} $args {
        switch -- $key {
            -to {
                lappend newArgs -to $val
            }
            -timeout {
                lappend newArgs -timeout $val
            }
            -command {
                set commands [list $val]
            }
            default {
                return -code error \
                       [::msgcat::mc "Illegal option \"%s\"" $key]
            }
        }
    }

    eval [list ::xmpp::sendIQ $xlib get \
	            -query [::xmpp::xml::create ping -xmlns urn:xmpp:ping] \
	            -command [namespace code [list ParseAnswer $commands]]] \
               $newArgs
}

# ::xmpp::ping::ParseAnswer --
#
#       A helper procedure which is called upon XMPP ping answer is received.
#       It calls back the status and error message if any.
#
# Arguments:
#       commands        A list of callbacks to call (only the first of them
#                       is invoked. Status and error stanza are appended to
#                       the called command.
#       status          Ping request status (ok, error, abort, timeout).
#       xml             Error message or result.
#
# Result:
#       Empty string.
#
# Side effects:
#       A callback is called if their list isn't empty.

proc ::xmpp::ping::ParseAnswer {commands status xml} {
    if {[llength $commands] > 0} {
        uplevel #0 [lindex $commands 0] [list $status $xml]
    }
    return
}

# ::xmpp::ping::register --
#
#       Register handler to answer XMPP ping IQ requests.
#
# Arguments:
#       -command cmd    (optional) Command to call when ping request is
#                       arrived. The result of the command is sent back.
#                       It must be either {result {}}, or {error type condition},
#                       or empty string if the application will reply to the
#                       request separately.
#                       The command's arguments are xlib, from, xml, and
#                       optional parameters -to, -id, -lang.
#
# Result:
#       Empty string.
#
# Side effects:
#       XMPP ping callback is registered.

proc ::xmpp::ping::register {args} {
    set commands {}
    foreach {key val} $args {
        switch -- $key {
            -command {
                set commands [list $val]
            }
            default {
                return -code error \
                       [::msgcat::mc "Illegal option \"%s\"" $key]
            }
        }
    }

    ::xmpp::iq::register get ping urn:xmpp:ping \
                         [namespace code [list ParseRequest $commands]]
    return
}

# ::xmpp::ping::ParseRequest --
#
#       A helper procedure which is called on any incoming XMPP ping request.
#       It either calls a command specified during registration or simply
#       returns result (if there weren't any command).
#
# Arguments:
#       commands            A list of commands to call (only the first one
#                           will be invoked).
#       xlib                XMPP token where request was received.
#       from                JID of user who sent the request.
#       xml                 Request XML element (in ping requests it is empty).
#       args                optional arguments (-lang, -to, -id).
#
# Result:
#       Either {result, {}}, or {error type condition}, or empty string, if
#       the application desided to reply later.
#
# Side effects:
#       Side effects of the called command.

proc ::xmpp::ping::ParseRequest {commands xlib from xml args} {
    if {[llength $commands] > 0} {
        return [uplevel #0 [lindex $commands 0] [list $xlib $from] $args]
    } else {
        return [list result {}]
    }
}

# ::xmpp::ping::unregister --
#
#       Unregister handler which used to answer XMPP ping IQ requests.
#
# Arguments:
#       None.
#
# Result:
#       Empty string.
#
# Side effects:
#       XMPP ping callback is registered.

proc ::xmpp::ping::unregister {} {
    ::xmpp::iq::unregister get ping urn:xmpp:ping

    return
}

# vim:ts=8:sw=4:sts=4:et
