# $Id: iq.tcl 1385 2008-03-06 19:14:22Z sergei $

namespace eval iq {
    variable options

    custom::defgroup IQ [::msgcat::mc "Info/Query options."] -group Tkabber

    custom::defvar options(show_iq_requests) 0 \
        [::msgcat::mc "Show IQ requests in the status line."] \
	-group IQ -type boolean

    custom::defvar options(shorten_iq_namespaces) 1 \
        [::msgcat::mc "Strip leading \"http://jabber.org/protocol/\" from IQ namespaces in the status line."] \
	-group IQ -type boolean
}

proc iq::register_handler {type tag xmlns h} {
    variable handler
    variable supported_ns

    set handler($type,$tag,$xmlns) $h
    lappend supported_ns $xmlns
    set supported_ns [lrmdups $supported_ns]
}

proc iq::process_iq {connid from useid id type lang child} {
    variable handler
    variable options

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    set xmlns [jlib::wrapper:getattr $vars xmlns]

    if {[info exists handler($type,$tag,$xmlns)]} {
	set h $handler($type,$tag,$xmlns)
    } elseif {[info exists handler($type,,$xmlns)]} {
	set h $handler($type,,$xmlns)
    }

    if {$options(show_iq_requests) && \
	    ($from != "" && \
	    !([string equal -nocase $from [jlib::connection_server $connid]] || \
	      [string equal -nocase $from [jlib::connection_bare_jid $connid]] || \
	      [string equal -nocase $from [jlib::connection_jid $connid]]))} {
	set xmlns_short $xmlns
	if {$options(shorten_iq_namespaces) &&
		[string first "http://jabber.org/protocol/" $xmlns_short] == 0} {
	    set xmlns_short [string range $xmlns_short 27 end]
	}
	set_status [format [::msgcat::mc "%s request from %s"] $xmlns_short $from]
    }
    if {[info exists h]} {
	set res [eval $h [list $connid $from $lang $child]]

	if {$res != {}} {
	    switch -- [lindex $res 0] {
		result {
		    debugmsg iq "IQREPLY: SENDING RESULT: $from; $useid; $id; $child"
		    jlib::send_iq result [lindex $res 1] \
			-to $from \
			-connection $connid \
			-id $id
		}
		error {
		    debugmsg iq "IQREPLY: SENDING ERROR: $from; $useid; $id; $child"
		    jlib::send_iq error \
			[eval stanzaerror::error [lrange $res 1 end] -xml {$child}] \
			-to $from \
			-connection $connid \
			-id $id
		}
		ignore {
		    # Do nothing, swallow the request
		}
	    }
	}
    } else {
	debugmsg iq "IQREPLY: SENDING 503: $from; $useid; $id; $child"
	jlib::send_iq error \
	    [stanzaerror::error cancel service-unavailable -xml $child] \
	    -to $from \
	    -connection $connid \
	    -id $id
    }
}

proc client:iqreply {connid from useid id type lang child} {
    debugmsg iq "IQREPLY: $from; $useid; $id; $type; $lang; $child"

    iq::process_iq $connid $from $useid $id $type $lang $child
}


plugins::load [file join plugins iq]

