# $Id: pubsub.tcl 1373 2008-02-05 19:19:06Z sergei $
#
# Publish-Subscribe Support (XEP-0060)
# Personal Eventing via Pubsub Support (XEP-0163)
#

##########################################################################
#
# Publish-subscribe XEP-0060
#

namespace eval pubsub {
    variable ns
    array set ns [list \
	collections                "http://jabber.org/protocol/pubsub#collections" \
	config-node                "http://jabber.org/protocol/pubsub#config-node" \
	create-and-configure       "http://jabber.org/protocol/pubsub#create-and-configure" \
	create-nodes               "http://jabber.org/protocol/pubsub#create-nodes" \
	delete-any                 "http://jabber.org/protocol/pubsub#delete-any" \
	delete-nodes               "http://jabber.org/protocol/pubsub#delete-nodes" \
	get-pending                "http://jabber.org/protocol/pubsub#get-pending" \
	instant-nodes              "http://jabber.org/protocol/pubsub#instant-nodes" \
	item-ids                   "http://jabber.org/protocol/pubsub#item-ids" \
	leased-subscription        "http://jabber.org/protocol/pubsub#leased-subscription" \
	meta-data                  "http://jabber.org/protocol/pubsub#meta-data" \
	manage-subscription        "http://jabber.org/protocol/pubsub#manage-subscription" \
	modify-affiliations        "http://jabber.org/protocol/pubsub#modify-affiliations" \
	multi-collection           "http://jabber.org/protocol/pubsub#multi-collection" \
	multi-subscribe            "http://jabber.org/protocol/pubsub#multi-subscribe" \
	outcast-affiliation        "http://jabber.org/protocol/pubsub#outcast-affiliation" \
	persistent-items           "http://jabber.org/protocol/pubsub#persistent-items" \
	presence-notifications     "http://jabber.org/protocol/pubsub#presence-notifications" \
	publish                    "http://jabber.org/protocol/pubsub#publish" \
	publisher-affiliation      "http://jabber.org/protocol/pubsub#publisher-affiliation" \
	purge-nodes                "http://jabber.org/protocol/pubsub#purge-nodes" \
	retract-items              "http://jabber.org/protocol/pubsub#retract-items" \
	retrieve-affiliations      "http://jabber.org/protocol/pubsub#retrieve-affiliations" \
	retrieve-default           "http://jabber.org/protocol/pubsub#retrieve-default" \
	retrieve-items             "http://jabber.org/protocol/pubsub#retrieve-items" \
	retrieve-subscriptions     "http://jabber.org/protocol/pubsub#retrieve-subscriptions" \
	subscribe                  "http://jabber.org/protocol/pubsub#subscribe" \
	subscription-options       "http://jabber.org/protocol/pubsub#subscription-options" \
	subscription-notifications "http://jabber.org/protocol/pubsub#subscription-notifications" \
	subscribe_authorization    "http://jabber.org/protocol/pubsub#subscribe_authorization" \
	subscribe_options          "http://jabber.org/protocol/pubsub#subscribe_options" \
	node_config                "http://jabber.org/protocol/pubsub#node_config" \
	event                      "http://jabber.org/protocol/pubsub#event"]

    variable m2a
    variable a2m
    set aff_list [list [::msgcat::mc "Owner"] owner \
		       [::msgcat::mc "Publisher"] publisher \
		       [::msgcat::mc "None"] none \
		       [::msgcat::mc "Outcast"] outcast]
    foreach {m a} $aff_list {
	set m2a($m) $a
	set a2m($a) $m
    }

    variable m2s
    variable s2m
    set subsc_list [list [::msgcat::mc "None"] none \
			 [::msgcat::mc "Pending"] pending \
			 [::msgcat::mc "Unconfigured"] unconfigured \
			 [::msgcat::mc "Subscribed"] subscribed]
    foreach {m s} $subsc_list {
	set m2s($m) $s
	set s2m($s) $m
    }
}

##########################################################################
#
# Entity use cases (5)
#

##########################################################################
#
# Discover features (5.1) is implemented in disco.tcl
# Discover nodes (5.2) is implemented in disco.tcl
# Discover node information (5.3) is implemented in disco.tcl
# Discover node meta-data (5.4) is implemented in disco.tcl
#

##########################################################################
#
# Discover items for a node (5.5) is NOT implemented in disco.tcl
# TODO
#

##########################################################################
#
# Retrieve subscriptions (5.6)
#
# Evaluates command for attribute lists
#

proc pubsub::retrieve_subscriptions {service args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::retrieve_subscriptions: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::retrieve_subscriptions: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [list [jlib::wrapper:createtag subscriptions]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::retrieve_subscriptions_result $command]
}

proc pubsub::retrieve_subscriptions_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

    set items {}

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 != "subscriptions"} continue

	foreach item $children1 {
	    jlib::wrapper:splitxml \
		$item tag2 vars2 isempty2 chdata2 children2

	    if {$tag2 == "subscription"} {
		lappend items $vars2
	    }
	}
    }

    if {$command != ""} {
	eval $command [list $res $items]
    }
}

##########################################################################
#
# Retrieve affiliations (5.6)
#
# Evaluates command for attribute lists
#

proc pubsub::retrieve_affiliations {service args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::retrieve_affiliations: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::retrieve_affiliations: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [list [jlib::wrapper:createtag affiliations]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::retrieve_affiliations_result $command]
}

proc pubsub::retrieve_affiliations_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

    set items {}

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 != "affiliations"} continue

	foreach item $children1 {
	    jlib::wrapper:splitxml \
		$item tag2 vars2 isempty2 chdata2 children2

	    if {$tag2 == "affiliation"} {
		lappend items $vars2
	    }
	}
    }

    if {$command != ""} {
	eval $command [list $res $items]
    }
}

##########################################################################
#
# Subscriber use cases (6)
#

##########################################################################
#
# Subscribe to pubsub node "node" at service "service" (6.1)
#
# if node is empty then it's a subscription to root collection node (9.2)
#
# -jid "jid" is optional (when it's present it's included to sub request)
#
# -resource "res" is optional (when it's present bare_jid/res is included
# to sub request
#
# if both options are absent then user's bare JID is included to sub
# request
#
# Optional pubsub#subscribe_options parameters
# -deliver
# -digest
# -expire
# -include_body
# -show-values
# -subscription_type
# -subscription_depth
#

proc pubsub::subscribe {service node args} {
    variable ns

    debugmsg pubsub [info level 0]

    set command ""
    set options {}
    foreach {key val} $args {
	switch -- $key {
	    -jid { set jid $val }
	    -resource { set resource $val }
	    -connection { set connid $val}
	    -command { set command $val }
	    -deliver -
	    -digest -
	    -expire -
	    -include_body -
	    -show-values -
	    -subscription_type -
	    -subscription_depth {
		lappend options [field "pubsub#[string range $opt 1 end]" $val]
	    }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::subscribe: -connection is mandatory"
    }

    if {![info exists jid]} {
	set jid [jlib::connection_bare_jid $connid]
    }

    if {[info exists resource]} {
	append jid "/$resource"
    }

    set vars [list jid $jid]
    if {$node != ""} {
	lappend vars node $node
    }

    if {![lempty $options]} {
	set options \
	    [list [jlib::wrapper:createtag options \
		       -subtags \
			   [list [jlib::wrapper:createtag x \
				      -vars [list xmlns $::NS(data) \
						  type submit] \
				      -subtags \
					  [linsert $options 0 \
						   [form_type $ns(subscribe_options)]]]]]]
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [concat [list [jlib::wrapper:createtag subscribe \
					 -vars $vars]] \
			      $options]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::subscribe_result $command]
}

proc pubsub::subscribe_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$res == "OK"} {
	jlib::wrapper:splitxml $child tag vars isempty chdata children

	if {[jlib::wrapper:getattr $vars xmlns] == $::NS(pubsub)} {
	    foreach child1 $children {
		jlib::wrapper:splitxml \
		    $child1 tag1 vars1 isempty1 chdata1 children1
		if {$tag == "subscription"} {
		    set node [jlib::wrapper:getattr $vars1 node]
		    set jid [jlib::wrapper:getattr $vars1 jid]
		    set subid [jlib::wrapper:getattr $vars1 subid]
		    set subscription \
			[jlib::wrapper:getattr $vars1 subscription]
		    # TODO: subscription-options
		    if {$command != ""} {
			eval $command [list $res \
					    [list $node $jid \
						  $subid $subscription]]
			return
		    }
		}
	    }
	    if {$command != ""} {
		# Something strange: OK without subscription details
		eval $command [list $res {}]
		return
	    }
	}
    }

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Unsubscribe from pubsub node "node" at service "service" (6.2)
#
# if node is empty then it's a unsubscription from root collection node (9.2)
#
# -jid "jid" is optional (when it's present it's included to sub request)
#
# -resource "res" is optional (when it's present bare_jid/res is included
# to sub request
#
# if both options are absent then user's bare JID is included to sub
# request
#

proc pubsub::unsubscribe {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -jid { set jid $val }
	    -subid { set subid $val }
	    -resource { set resource $val }
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::unsubscribe: -connection is mandatory"
    }

    if {![info exists jid]} {
	set jid [jlib::connection_bare_jid $connid]
    }

    if {[info exists resource]} {
	append jid "/$resource"
    }

    set vars [list jid $jid]
    if {$node != ""} {
	lappend vars node $node
    }
    if {[info exists subid]} {
	lappend vars subid $subid
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [list [jlib::wrapper:createtag unsubscribe \
				 -vars $vars]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::unsubscribe_result $command]
}

proc pubsub::unsubscribe_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Configure subscription options (6.3)
#

proc pubsub::request_subscription_options {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -jid { set jid $val }
	    -subid { set subid $val }
	    -resource { set resource $val }
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::request_subscription_options: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error \
	    "pubsub::request_subscription_options: Node is empty"
    }

    if {![info exists jid]} {
	set jid [jlib::connection_bare_jid $connid]
    }

    if {[info exists resource]} {
	append jid "/$resource"
    }

    if {[info exists subid]} {
	set vars [list node $node subid $subid jid $jid]
    } else {
	set vars [list node $node jid $jid]
    }

    jlib::send_iq get \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [list [jlib::wrapper:createtag options \
				 -vars $vars]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::subscription_options_result \
		       $connid $service $command]
}

proc pubsub::subscription_options_result {connid service command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 == "options"} {
	    jlib::wrapper:splitxml \
		[lindex $children1 0] tag2 vars2 isempty2 chdata2 children2
	    set node [jlib::wrapper:getattr $vars2 node]
	    set jid [jlib::wrapper:getattr $vars2 jid]
	    set subid [jlib::wrapper:getattr $vars2 subid]
	    break
	}
    }

    data::draw_window $children2 \
	[list [namespace current]::send_subscribe_options
	      $connid $service $node $jid $subid $command]
}

proc pubsub::send_subscribe_options {connid service node jid subid command w restags} {

    debugmsg pubsub [info level 0]

    destroy $w.error.msg
    $w.bbox itemconfigure 0 -state disabled

    if {$subid != ""} {
	set vars [list node $node subid $subid jid $jid]
    } else {
	set vars [list node $node jid $jid]
    }

    jlib::send_iq set [jlib::wrapper:createtag pubsub \
			   -vars [list xmlns $::NS(pubsub)] \
			   -subtags [jlib::wrapper:createtag options \
					 -vars $vars \
					 -subtags $restags]] \
	-to $service \
	-connection $connid \
	-command [list data::test_error_res $w]
}

##########################################################################
#
# Retrieve items for a node (6.4)
# Node must not be empty
# Evaluates command with list of items
#
# -max_items $number (request $number last items)
# -items $item_id_list (request specific items)

proc pubsub::retrieve_items {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    set items {}
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val }
	    -command { set command $val }
	    -subid { set subid $val }
	    -max_items { set max_items $val }
	    -items {
		foreach id $val {
		    lappend items [jlib::wrapper:createtag item
				       -vars [list id $id]]
		}
	    }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::retrieve_items: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::retrieve_items: Node is empty"
    }

    if {[info exists subid]} {
	set vars [list node $node subid $subid]
    } else {
	set vars [list node $node]
    }

    if {[info exists max_items]} {
	lappend vars max_items $max_items
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [list [jlib::wrapper:createtag items \
				 -vars $vars \
				 -subtags $items]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::get_items_result $command]
}

proc pubsub::get_items_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

    set items {}

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 != "items"} continue

	foreach item $children1 {
	    jlib::wrapper:splitxml \
		$item tag2 vars2 isempty2 chdata2 children2

	    if {$tag2 == "item"} {
		lappend items $item
	    }
	}
    }

    if {$command != ""} {
	eval $command [list $res $items]
    }
}

##########################################################################
#
# Publisher use cases (7)
#

##########################################################################
#
# Publish item "itemid" to pubsub node "node" at service "service" (7.1)
# payload is a LIST of xml tags
# node must not be empty

proc pubsub::publish_item {service node itemid args} {

    debugmsg pubsub [info level 0]

    set command ""
    set payload {}
    set transient 0
    foreach {key val} $args {
	switch -- $key {
	    -transient { set transient $val }
	    -payload { set payload $val }
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::publish_item: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::publish_item: Node is empty"
    }

    if {$itemid == ""} {
	set vars {}
    } else {
	set vars [list id $itemid]
    }

    if {$transient} {
	set item {}
    } else {
	set item [list [jlib::wrapper:createtag item \
			    -vars $vars \
			    -subtags $payload]]
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [list [jlib::wrapper:createtag publish \
				 -vars [list node $node] \
				 -subtags $item]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::publish_item_result $command]
}

proc pubsub::publish_item_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Delete item "itemid" from pubsub node "node" at service "service" (7.2)
# node and itemid must not be empty
# -notify is a boolean (true, false, 1, 0)

proc pubsub::delete_item {service node itemid args} {

    debugmsg pubsub [info level 0]

    set command ""
    set notify 0
    foreach {key val} $args {
	switch -- $key {
	    -notify { set notify $val }
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::delete_item: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::delete_item: Node is empty"
    }

    if {$itemid == ""} {
	return -code error "pubsub::delete_item: Item ID is empty"
    }

    set vars [list node $node]
    if {[string is true -strict $notify]} {
	lappend vars notify true
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags \
		 [list [jlib::wrapper:createtag retract \
			    -vars $vars \
			    -subtags \
				[list [jlib::wrapper:createtag item \
					   -vars [list id $itemid]]]]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::delete_item_result $command]
}

proc pubsub::delete_item_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Owner use cases (8)
#

##########################################################################
#
# Create pubsub node "node" at service "service" (8.1)
#
# 8.1.2 create_node service node -connection connid -command callback
# or    create_node service node -access_model model -connection connid \
#				 -command callback
#
# 8.1.3 create_node service node -connection connid -command callback \
#				 -title title \
#				  ........... \
#				 -body_xslt xslt
#
# Optional pubsub#node_config parameters
# -access_model
# -body_xslt
# -collection
# -dataform_xslt
# -deliver_notifications
# -deliver_payloads
# -itemreply
# -children_association_policy
# -children_association_whitelist
# -children
# -children_max
# -max_items
# -max_payload_size
# -node_type
# -notify_config
# -notify_delete
# -notify_retract
# -persist_items
# -presence_based_delivery
# -publish_model
# -replyroom
# -replyto
# -roster_groups_allowed
# -send_last_published_item
# -subscribe
# -title
# -type

proc pubsub::create_node {service node args} {
    variable ns

    debugmsg pubsub [info level 0]

    set command ""
    set options {}
    set fields {}
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	    -access_model -
	    -body_xslt -
	    -collection -
	    -dataform_xslt -
	    -deliver_notifications -
	    -deliver_payloads -
	    -itemreply -
	    -children_association_policy -
	    -children_association_whitelist -
	    -children -
	    -children_max -
	    -max_items -
	    -max_payload_size -
	    -node_type -
	    -notify_config -
	    -notify_delete -
	    -notify_retract -
	    -persist_items -
	    -presence_based_delivery -
	    -publish_model -
	    -replyroom -
	    -replyto -
	    -roster_groups_allowed -
	    -send_last_published_item -
	    -subscribe -
	    -title -
	    -type {
		lappend fields [field "pubsub#[string range $opt 1 end]" $val]
	    }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::create_node: -connection is mandatory"
    }

    if {$node == ""} {
	set vars {}
    } else {
	set vars [list node $node]
    }

    if {![lempty $fields]} {
	set fields [linsert $fields 0 [form_type $ns(node_config)]]
	set fields \
	    [list [jlib::wrapper:createtag x \
		       -vars [list xmlns $::NS(data) \
				   type submit] \
		       -subtags \
			   [linsert $fields 0 \
				    [form_type $ns(node_config)]]]]
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags [list [jlib::wrapper:createtag create \
				 -vars $vars] \
			    [jlib::wrapper:createtag configure \
				 -subtags $fields]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::create_node_result \
		       $node $command]
}

proc pubsub::form_type {value} {
    return [jlib::wrapper:createtag field \
		-vars [list var FORM_TYPE \
			    type hidden]
		-subtags [list [jlib::wrapper:createtag value \
				    -chdata $value]]]
}

proc pubsub::field {var value} {
    return [jlib::wrapper:createtag field \
		-vars [list var $var] \
		-subtags [list [jlib::wrapper:createtag value \
				    -chdata $value]]]
}

proc pubsub::create_node_result {node command res child} {

    debugmsg pubsub [info level 0]

    if {$res == "OK" && $node == ""} {
	# Instant node: get node name from the answer

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

	if {[jlib::wrapper:getattr $vars xmlns] == $::NS(pubsub)} {
	    foreach child1 $children {
		jlib::wrapper:splitxml \
		    $child1 tag1 vars1 isempty1 chdata1 children1
		if {$tag == "create"} {
		    set node [jlib::wrapper:getattr $vars1 node]
		}
	    }
	}
    }

    if {$command != ""} {
	eval $command [list $node $res $child]
    }
}

##########################################################################
#
# Configure pubsub node "node" at service "service" (8.2)
# node must not be empty
#

proc pubsub::configure_node {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::configure_node: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error \
	    "pubsub::configure_node: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list [jlib::wrapper:createtag configure \
				 -vars [list node $node]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::configure_node_result \
		       $connid $service $command]
}

proc pubsub::configure_node_result {connid service command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 == "configure"} {
	    set node [jlib::wrapper:getattr $vars1 node]
	    jlib::wrapper:splitxml \
		[lindex $children1 0] tag2 vars2 isempty2 chdata2 children2
	    break
	}
    }

    data::draw_window $children2 \
	[list [namespace current]::send_configure_node
	      $connid $service $node $command]
}

proc pubsub::send_configure_node {connid service node command w restags} {

    debugmsg pubsub [info level 0]

    destroy $w.error.msg
    $w.bbox itemconfigure 0 -state disabled

    jlib::send_iq set [jlib::wrapper:createtag pubsub \
			   -vars [list xmlns $::NS(pubsub#owner)] \
			   -subtags [jlib::wrapper:createtag configure \
					 -vars [list node $node] \
					 -subtags $restags]] \
	-to $service \
	-connection $connid \
	-command [list data::test_error_res $w]
}

##########################################################################
#
# Request default configuration options (8.3)
#

proc pubsub::request_default {service args} {
    variable ns

    debugmsg pubsub [info level 0]

    set command ""
    set form [jlib::wrapper:createtag default]
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	    -node_type {
		set form \
		    [jlib::wrapper:createtag default \
			 -subtags [list [jlib::wrapper:createtag x \
					     -vars [list xmlns $::NS(data) \
							 type submit] \
					     -subtags [list [form_type $ns(node_config)] \
							    [field pubsub#node_type $val]]]]]
	    }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::request_default: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error \
	    "pubsub::request_default: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list $form] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::request_default_result \
		       $connid $service $command]
}

proc pubsub::request_default_result {connid service command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 == "default"} {
	    jlib::wrapper:splitxml \
		[lindex $children1 0] tag2 vars2 isempty2 chdata2 children2
	    break
	}
    }

    # TODO: Don't send the form
    data::draw_window $children2 \
	[list [namespace current]::send_request_results
	      $connid $service $node $command]
}

proc pubsub::send_request_results {connid service node command w restags} {

    debugmsg pubsub [info level 0]

    destroy $w.error.msg
    $w.bbox itemconfigure 0 -state disabled

    jlib::send_iq set [jlib::wrapper:createtag pubsub \
			   -vars [list xmlns $::NS(pubsub#owner)] \
			   -subtags [jlib::wrapper:createtag default \
					 -subtags $restags]] \
	-to $service \
	-connection $connid \
	-command [list data::test_error_res $w]
}

##########################################################################
#
# Delete a node (8.4)
# node must not be empty
#

proc pubsub::delete_node {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::delete_node: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::delete_node: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list [jlib::wrapper:createtag delete \
				 -vars [list node $node]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::delete_node_result $command]
}

proc pubsub::delete_node_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Purge all node items (8.5)
# node must not be empty
#

proc pubsub::purge_items {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error "pubsub::purge_items: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::purge_items: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list [jlib::wrapper:createtag purge \
				 -vars [list node $node]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::purge_items_result $command]
}

proc pubsub::purge_items_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Manage subscription requests (8.6)
# is done in messages.tcl
#

##########################################################################
#
# Request all pending subscription requests (8.6.1)
#

proc pubsub::request_pending_subscription {service args} {
    variable ns

    debugmsg pubsub [info level 0]

    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::request_pending_subscription: -connection is mandatory"
    }

    # Let xcommands.tcl do the job
    xcommands::execute $service $ns(get-pending) -connection $connid
}

##########################################################################
#
# Manage subscriptions (8.7)
#
# Callback is called with list of entities:
# {jid JID subscription SUB subid ID}
#

proc pubsub::request_subscriptions {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::request_subscriptions: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::request_subscriptions: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list [jlib::wrapper:createtag subscriptions \
				 -vars [list node $node]]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::subscriptions_result $command]
}

proc pubsub::subscriptions_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

    set entities {}

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 != "subscriptions"} continue

	foreach entity $children1 {
	    jlib::wrapper:splitxml \
		$entity tag2 vars2 isempty2 chdata2 children2

	    if {$tag2 == "subscription"} {
		lappend entities $vars2
	    }
	}
    }

    if {$command != ""} {
	eval $command [list $res $entities]
    }
}

##########################################################################

proc pubsub::modify_subscriptions {service node entities args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::modify_subscriptions: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::modify_subscriptions: Node is empty"
    }

    set subscriptions {}
    foreach entity $entities {
	lappend subscriptions [jlib::wrapper:createtag subscription \
				   -vars $entity]
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list [jlib::wrapper:createtag subscriptions \
				 -vars [list node $node] \
				 -subtags $subscriptions]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::modify_subscriptions_result $command]
}

proc pubsub::modify_subscriptions_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Retrieve current affiliations (8.8)
# Evaluates command with list of entity attributes lists
#

proc pubsub::request_affiliations {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::request_affiliations: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::request_affiliations: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list [jlib::wrapper:createtag affiliations]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::affiliations_result $command]
}

proc pubsub::affiliations_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
	return
    }

    set entities {}

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

    foreach ch $children {
	jlib::wrapper:splitxml $ch tag1 vars1 isempty1 chdata1 children1

	if {$tag1 != "affiliations"} continue

	foreach entity $children1 {
	    jlib::wrapper:splitxml \
		$entity tag2 vars2 isempty2 chdata2 children2

	    if {$tag2 == "affiliation"} {
		lappend entities $vars2
	    }
	}
    }

    if {$command != ""} {
	eval $command [list $res $entities]
    }
}

##########################################################################

proc pubsub::modify_affiliations {service node entities args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::modify_subscriptions: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::modify_subscriptions: Node is empty"
    }

    set affiliations {}
    foreach entity $entities {
	lappend affiliations [jlib::wrapper:createtag affiliation \
				   -vars $entity]
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub#owner)] \
	     -subtags [list [jlib::wrapper:createtag affiliations \
				 -vars [list node $node] \
				 -subtags $affiliations]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::modify_affiliations_result $command]
}

proc pubsub::modify_affiliations_result {command res child} {

    debugmsg pubsub [info level 0]

    if {$command != ""} {
	eval $command [list $res $child]
    }
}

##########################################################################
#
# Modifying entity affiliations
# node must not be empty
# TODO
#

proc pubsub::request_entities {service node args} {

    debugmsg pubsub [info level 0]

    set command ""
    foreach {key val} $args {
	switch -- $key {
	    -connection { set connid $val}
	    -command { set command $val }
	}
    }

    if {![info exists connid]} {
	return -code error \
	       "pubsub::request_entities: -connection is mandatory"
    }

    if {$node == ""} {
	return -code error "pubsub::request_entities error: Node is empty"
    }

    jlib::send_iq set \
	[jlib::wrapper:createtag pubsub \
	     -vars [list xmlns $::NS(pubsub)] \
	     -subtags \
		 [list [jlib::wrapper:createtag entities \
			    -vars [list node $node]]] \
	-to $service \
	-connection $connid \
	-command [list [namespace current]::receive_entities \
		       $connid $service $command]
}

proc pubsub::receive_entities {connid service command res child} {
    variable winid

    debugmsg pubsub [info level 0]

    if {$res != "OK"} {
	if {$command != ""} {
	    eval $command [list $res $child]
	}
    }

    jlib::wrapper:splitxml $child tag vars isempty chdata children
    foreach child1 $children {
	jlib::wrapper:splitxml $child1 tag1 vars1 isempty1 chdata1 children1
	if {$tag1 == "entities"} {
	    set node [jlib::wrapper:getattr $vars1 node]
	    set entities $children1
	    break
	}
    }

    if {![info exists winid]} {
	set winid 0
    } else {
	incr winid
    }
    set w .pubsub_entities$winid

    if {[winfo exists $w]} {
	destroy $w
    }

    Dialog $w -title [::msgcat::mc "Edit entities affiliations: %s" $node] \
        -modal none -separator 1 -anchor e -default 0 -cancel 1 \
        -parent .

    set wf [$w getframe]

    set sw [ScrolledWindow $wf.sw -scrollbar vertical]
    set sf [ScrollableFrame $w.fields -constrainedwidth yes]
    set f [$sf getframe]
    $sw setwidget $sf
    fill_list $sf $f $entities
    list_add_item $sf $f
 
    $w add -text [::msgcat::mc "Send"] \
	-command [list [namespace current]::send_entities \
		       $connid $service $node $w $f]
    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
    bind $w <Destroy> \
	 [list after idle [list [namespace current]::cleanup_entities $w $f]]

    button $w.add -text [::msgcat::mc "Add"] \
	-command [list [namespace current]::list_add_item $sf $f]
    pack $w.add -side bottom -anchor e -in $wf -padx 1m -pady 1m
    pack $sw -side top -expand yes -fill both

    bindscroll $f $sf

    set hf [frame $w.hf]
    pack $hf -side top
    set vf [frame $w.vf]
    pack $vf -side left

    update idletasks
    $hf configure -width [expr {[winfo reqwidth $f] + [winfo pixels $f 1c]}]

    set h [winfo reqheight $f]
    set sh [winfo screenheight $w]
    if {$h > $sh - 200} {
	set h [expr {$sh - 200}]
    }
    $vf configure -height $h

    $w draw
}

proc pubsub::fill_list {sf f entities} {
    variable a2m
    variable s2m
    variable listdata
    variable origlistdata

    debugmsg pubsub [info level 0]

    grid columnconfigure $f 0 -weight 1
    grid columnconfigure $f 1 -weight 1
    grid columnconfigure $f 2 -weight 1
    grid columnconfigure $f 3 -weight 1

    label $f.ljid -text [::msgcat::mc "Jabber ID"]
    grid $f.ljid -row 0 -column 0 -sticky we -padx 1m
    bindscroll $f.ljid $sf

    label $f.lsubid -text [::msgcat::mc "SubID"]
    grid $f.lsubid -row 0 -column 1 -sticky we -padx 1m
    bindscroll $f.lsubid $sf

    label $f.laffiliation -text [::msgcat::mc "Affiliation"]
    grid $f.laffiliation -row 0 -column 2 -sticky we -padx 1m
    bindscroll $f.laffiliation $sf

    label $f.lsubscription -text [::msgcat::mc "Subscription"]
    grid $f.lsubscription -row 0 -column 3 -sticky we -padx 1m
    bindscroll $f.lsubscription $sf

    set row 1

    set entities2 {}
    foreach entity $entities {
	jlib::wrapper:splitxml $entity tag vars isempty chdata children
	switch -- $tag {
	    entity {
		set jid [jlib::wrapper:getattr $vars jid]
		set subid [jlib::wrapper:getattr $vars subid]
		set affiliation [jlib::wrapper:getattr $vars affiliation]
		set subscription [jlib::wrapper:getattr $vars subscription]
		lappend entities2 [list $jid $subid $affiliation $subscription]
	    }
	}
    }

    foreach entity [lsort -dictionary -index 0 $entities2] {
	lassign $item jid subid affiliation subscription

	label $f.jid$row -text $jid \
	    -textvariable [namespace current]::listdata($f,jid,$row)
	grid $f.jid$row -row $row -column 0 -sticky w -padx 1m
	bindscroll $f.jid$row $sf

	label $f.subid$row -text $subid \
	    -textvariable [namespace current]::listdata($f,subid,$row)
	grid $f.subid$row -row $row -column 1 -sticky w -padx 1m
	bindscroll $f.subid$row $sf

	ComboBox $f.affiliation$row -text $a2m($affiliation) \
	    -values [list $a2m(owner) \
			  $a2m(publisher) \
			  $a2m(none) \
			  $a2m(outcast)] \
	    -editable no \
	    -width 9 \
	    -textvariable [namespace current]::listdata($f,affiliation,$row)
	grid $f.affiliation$row -row $row -column 2 -sticky we -padx 1m
	bindscroll $f.affiliation$row $sf

	ComboBox $f.subscription$row -text $s2m($subscription) \
	    -values [list $s2m(none) \
			  $s2m(pending) \
			  $s2m(unconfigured) \
			  $s2m(subscribed)] \
	    -editable no \
	    -width 12 \
	    -textvariable [namespace current]::listdata($f,subscription,$row)
	grid $f.subscription$row -row $row -column 3 -sticky we -padx 1m
	bindscroll $f.subscription$row $sf

	incr row
    }

    set listdata($f,rows) $row
    array set origlistdata [array get listdata $f,*]
}

proc pubsub::list_add_item {sf f} {
    variable a2m
    variable s2m
    variable listdata

    debugmsg pubsub [info level 0]

    set row $listdata($f,rows)

    entry $f.jid$row \
	-textvariable [namespace current]::listdata($f,jid,$row)
    grid $f.jid$row -row $row -column 0 -sticky we -padx 1m
    bindscroll $f.jid$row $sf

    entry $f.subid$row \
	-textvariable [namespace current]::listdata($f,subid,$row)
    grid $f.subid$row -row $row -column 1 -sticky we -padx 1m
    bindscroll $f.subid$row $sf

    ComboBox $f.affiliation$row -text $a2m(none) \
	-values [list $a2m(owner) \
		      $a2m(publisher) \
		      $a2m(none) \
		      $a2m(outcast)] \
	-editable no \
	-width 9 \
	-textvariable [namespace current]::listdata($f,affiliation,$row)
    grid $f.affiliation$row -row $row -column 2 -sticky we -padx 1m
    bindscroll $f.affiliation$row $sf

    ComboBox $f.subscription$row -text $s2m(none) \
	-values [list $s2m(none) \
		      $s2m(pending) \
		      $s2m(unconfigured) \
		      $s2m(subscribed)] \
	-editable no \
	-width 12 \
	-textvariable [namespace current]::listdata($f,subscription,$row)
    grid $f.subscription$row -row $row -column 3 -sticky we -padx 1m
    bindscroll $f.subscription$row $sf

    incr listdata($f,rows)
}

proc pubsub::send_entities {connid service node w f} {
    variable origlistdata
    variable listdata

    debugmsg pubsub [info level 0]

    set entities {}

    for {set i 1} {$i < $origlistdata($f,rows)} {incr i} {
	set vars {}
	if {$listdata($f,affiliation,$i) != $origlistdata($f,affiliation,$i)} {
	    lappend vars affiliation $listdata($f,affiliation,$i)
	}
	if {$listdata($f,subscription,$i) != $origlistdata($f,subscription,$i)} {
	    lappend vars subscription $listdata($f,subscription,$i)
	}

	if {$vars != {} && $origlistdata($f,jid,$i) != ""} {
	    lappend vars jid $origlistdata($f,jid,$i)
	    lappend entities [jlib::wrapper:createtag entity \
				  -vars $vars]
	}
    }

    for {} {$i < $listdata($f,rows)} {incr i} {
	set vars1 {}
	set vars2 {}
	set vars3 {}
	if {$listdata($f,affiliation,$i) != ""} {
	    lappend vars1 affiliation $listdata($f,affiliation,$i)
	}
	if {$listdata($f,subscription,$i) != ""} {
	    lappend vars1 subscription $listdata($f,subscription,$i)
	}
	if {$listdata($f,jid,$i) != ""} {
	    lappend vars2 jid $listdata($f,jid,$i)
	}
	if {$listdata($f,subid,$i) != ""} {
	    lappend vars3 subid $listdata($f,subid,$i)
	}

	if {$vars1 != {} && $vars2 != {} && $vars3 != {}} {
	    lappend entities [jlib::wrapper:createtag item \
				  -vars [concat $vars2 $vars3 $vars1]]
	}
    }

    set connid [chat::get_connid $chatid]
    set group [chat::get_jid $chatid]

    if {$entities != {}} {
	jlib::send_iq set \
	    [jlib::wrapper:createtag pubsub \
		 -vars [list xmlns $::NS(pubsub)] \
		 -subtags [list [jlib::wrapper:createtag entities \
				     -vars [list node $node] \
				     -subtags $entities]]] \
	    -to $service \
	    -connection $connid
    # TODO error checking
    }
    destroy $w
}

proc pubsub::cleanup_entities {w f} {
    variable listdata
    variable origlistdata

    debugmsg pubsub [info level 0]

    array unset listdata $f,*
    array unset origlistdata $f,*
}

##########################################################################
#
# Collection nodes (9)
#

##########################################################################
#
# Subscribe to a collection node (9.1)
# Implemented in
# pubsub::subscribe service node id -connection connid \
#		    -subscription_type {nodes|items} \
#		    -subscription_depth {1|all}
#

##########################################################################
#
# Root collection node (9.2)
# Implemented in pubsub::subscribe and pubsub::unsubscribe with empty node
#

##########################################################################
#
# Create collection node (9.3)
# Implemented in
# pubsub::create_node service node -connection connid \
#		      -node_type collection
#

##########################################################################
#
# Create a node associated with a collection (9.4)
# Implemented in
# pubsub::create_node service node -connection connid \
#		      -collection collection
#

##########################################################################
#
# Associate an existing node with a collection (9.5)
# Implemented in TODO

##########################################################################
#
# Diassociate an node from a collection (9.6)
# Implemented in TODO

##########################################################################
#
# Framework for handling of Pubsub event notifications.

proc pubsub::register_event_notification_handler {xmlns h} {
    variable handler
    variable supported_ns

    set handler($xmlns) $h
    set supported_ns [array names handler]
}

proc pubsub::process_event_notification {connid from mid type is_subject subject body \
    err thread priority x} {

    variable ::pubsub::ns
    variable handler

    set res ""

    foreach event $x {
	jlib::wrapper:splitxml $event tag vars isempty chdata children
	if {![string equal $tag event]} continue
	
	set xmlns [jlib::wrapper:getattr $vars xmlns]
	if {![string equal $xmlns $ns(event)]} continue

	foreach item $children {
	    jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	    if {![string equal $tag1 items]} continue

	    set node [jlib::wrapper:getattr $vars1 node]
	    if {![info exists handler($node)]} continue

	    set res stop
	    $handler($node) $connid $from $children1
	}
    }

    return $res    
}

hook::add process_message_hook pubsub::process_event_notification

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