[Tkabber-dev] r725 - in trunk/tkabber: . plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Sep 20 13:45:05 MSD 2006


Author: sergei
Date: 2006-09-20 13:44:58 +0400 (Wed, 20 Sep 2006)
New Revision: 725

Added:
   trunk/tkabber/pubsub.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/datagathering.tcl
   trunk/tkabber/disco.tcl
   trunk/tkabber/plugins/general/remote.tcl
Log:
	* datagathering.tcl, disco.tcl: Added processing and using of
	  multiple values in jabber:x:data forms (thanks to Artem Borodin).

	* plugins/general/remote.tcl: A few bugfixes (thanks to Artem
	  Borodin).

	* pubsub.tcl: Started implementing Publish-Subscribe (JEP-0060).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-09-19 07:43:26 UTC (rev 724)
+++ trunk/tkabber/ChangeLog	2006-09-20 09:44:58 UTC (rev 725)
@@ -1,3 +1,12 @@
+2006-09-20  Sergei Golovan  <sgolovan at nes.ru>
+	* datagathering.tcl, disco.tcl: Added processing and using of
+	  multiple values in jabber:x:data forms (thanks to Artem Borodin).
+
+	* plugins/general/remote.tcl: A few bugfixes (thanks to Artem
+	  Borodin).
+
+	* pubsub.tcl: Started implementing Publish-Subscribe (JEP-0060).
+
 2006-09-18  Sergei Golovan  <sgolovan at nes.ru>
 
 	* disco.tcl, examples/tools/jsend.tcl, examples/tools/rssbot.tcl,

Modified: trunk/tkabber/datagathering.tcl
===================================================================
--- trunk/tkabber/datagathering.tcl	2006-09-19 07:43:26 UTC (rev 724)
+++ trunk/tkabber/datagathering.tcl	2006-09-20 09:44:58 UTC (rev 725)
@@ -252,15 +252,14 @@
 	    continue
 	}
 	set label [jlib::wrapper:getattr $vars label]
-	set value ""
+	set values {}
 	foreach child $children {
 	    jlib::wrapper:splitxml $child tag1 vars1 isempty1 chdata1 children1
 	    if {$tag1 == "value"} {
-		# TODO multiple values
-		set value $chdata1
+		lappend values $chdata1
 	    }
 	}
-	lappend result [list $var $label $value]
+	lappend result [list $var $label $values]
     }
     return $result
 }

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2006-09-19 07:43:26 UTC (rev 724)
+++ trunk/tkabber/disco.tcl	2006-09-20 09:44:58 UTC (rev 725)
@@ -639,10 +639,11 @@
     set extranodes {}
     
     foreach extra $extras {
-	lassign $extra var label value
+	lassign $extra var label values
 	set tnode [jid_to_tag "extra $var $jid $node"]
 	lappend extranodes $tnode
 	set data [list extra $var $jid $node]
+	set value [join $values ", "]
 	set desc "$label ($var): $value"
 	set icon ""
 	

Modified: trunk/tkabber/plugins/general/remote.tcl
===================================================================
--- trunk/tkabber/plugins/general/remote.tcl	2006-09-19 07:43:26 UTC (rev 724)
+++ trunk/tkabber/plugins/general/remote.tcl	2006-09-20 09:44:58 UTC (rev 725)
@@ -333,16 +333,16 @@
 	}
 
 	foreach field [::data::parse_xdata_results $children -hidden 1] {
-	    lassign $field var label value
+	    lassign $field var label values
 	    if {[cequal $var FORM_TYPE]} {
-		if {![cequal $value $form_type]} {
+		if {![cequal [lindex $values 0] $form_type]} {
 		    return [list error cancel bad-request \
 				 -application-specific \
 				     [jlib::wrapper:createtag bad-payload \
 					  -vars [list xmlns $::NS(commands)]]]
 		}
 	    } else {
-		lappend result $var $value
+		lappend result $var $values
 	    }
 	}
     }
@@ -555,11 +555,11 @@
 			      -vars [list xmlns $::NS(commands)]]]
     }
 
-    set sessions(leave_groupchats,all,$sid) $params(all)
+    set sessions(leave_groupchats,all,$sid) [lindex $params(x-all) 0]
     set sessions(leave_groupchats,groupchats,$sid) $params(groupchats)
     set sessions(leave_groupchats,reason,$sid) ""
     catch {
-	set sessions(leave_groupchats,reason,$sid) [lindex $params(reason) 0]
+	set sessions(leave_groupchats,reason,$sid) [lindex $params(x-reason) 0]
     }
     return {}
 
@@ -647,7 +647,7 @@
 	lappend options \
 		[list $id \
 		      [format \
-			   [::trans::trans $lang "%s: %s $type message(s)"]
+			   [::trans::trans $lang "%s: %s $type message(s)"] \
 			   $name $count]]
     }
     if {[expr [llength $options] == 0]} {
@@ -691,7 +691,7 @@
     variable sessions
 
     set result [remote::standart_parseresult $children \
-					     "plugins:remote:forward_form"]
+					     "tkabber:plugins:remote:forward_form"]
     if {[cequal [lindex $result 0] error]} {
 	return $result
     }
@@ -704,7 +704,7 @@
 			      -vars [list xmlns $::NS(commands)]]]
     }
 
-    set sessions(forward,all,$sid) $params(all)
+    set sessions(forward,all,$sid) [lindex $params(all) 0]
     set sessions(forward,chats,$sid) $params(chats)
     return {}
 }

Added: trunk/tkabber/pubsub.tcl
===================================================================
--- trunk/tkabber/pubsub.tcl	                        (rev 0)
+++ trunk/tkabber/pubsub.tcl	2006-09-20 09:44:58 UTC (rev 725)
@@ -0,0 +1,1421 @@
+# $Id$
+#
+# Publish-Subscribe Support (JEP-0060)
+# Personal Eventing Protocol Support (JEP-0163)
+#
+
+namespace eval pubsub {
+    variable ns(get-pending) \
+	"http://jabber.org/protocol/pubsub#get-pending"
+    variable ns(subscribe_authorization) \
+	"http://jabber.org/protocol/pubsub#subscribe_authorization"
+    variable ns(node_config) \
+	"http://jabber.org/protocol/pubsub#node_config"
+
+    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
+    }
+}
+
+##########################################################################
+#
+# Create pubsub node "node" at service "service" (8.1.2)
+#
+
+proc pubsub::create_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]} {
+	set connid [jlib::route $service]
+    }
+
+    if {$node == ""} {
+	set vars {}
+    } else {
+	set vars [list node $node]
+    }
+
+    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]]] \
+	-to $service \
+	-connection $connid \
+	-command [list [namespace current]::create_node_result \
+		       $node $command]
+}
+
+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]
+    }
+}
+
+##########################################################################
+#
+# Publish item "itemid" to pubsub node "node" at service "service" (8.1.3)
+# 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 {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -payload { set payload $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	set connid [jlib::route $service]
+    }
+
+    if {$node == ""} {
+	return -code error "pubsub::publish_item error: Node is empty"
+    }
+
+    if {$itemid == ""} {
+	set vars {}
+    } else {
+	set vars [list id $itemid]
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags \
+		 [list [jlib::wrapper:createtag publish \
+			    -vars [list node $node] \
+			    -subtags [list [jlib::wrapper:createtag item \
+						-vars $vars \
+						-subtags $payload]]]]] \
+	-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" (8.1.4)
+# node and itemid must not be empty
+
+proc pubsub::delete_item {service node itemid 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]} {
+	set connid [jlib::route $service]
+    }
+
+    if {$node == ""} {
+	return -code error "pubsub::delete_item error: Node is empty"
+    }
+
+    if {$itemid == ""} {
+	return -code error "pubsub::delete_item error: Item ID is empty"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags \
+		 [list [jlib::wrapper:createtag retract \
+			    -vars [list node $node] \
+			    -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]
+    }
+}
+
+##########################################################################
+#
+# Subscribe to pubsub node "node" at service "service" (8.1.5)
+# node must not be empty
+#
+# -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::subscribe {service node args} {
+
+    debugmsg pubsub [info level 0]
+
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -jid { set jid $val }
+	    -resource { set resource $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	set connid [jlib::route $service]
+    }
+
+    if {![info exists jid]} {
+	set jid [jlib::connection_bare_jid $connid]
+	if {[info exists resource]} {
+	    append jid "/$resource"
+	}
+    }
+
+    if {$node == ""} {
+	return -code error "pubsub::subscribe error: Node is empty"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags [list [jlib::wrapper:createtag subscribe \
+				 -vars [list node $node jid $jid]]]] \
+	-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 == "entity"} {
+		    set node [jlib::wrapper:getattr $vars1 node]
+		    set jid [jlib::wrapper:getattr $vars1 jid]
+		    set affiliation \
+			[jlib::wrapper:getattr $vars1 affiliation]
+		    set subid [jlib::wrapper:getattr $vars1 subid]
+		    set subscription \
+			[jlib::wrapper:getattr $vars1 subscription]
+		    if {$command != ""} {
+			eval $command [list $res $node $jid $affiliation \
+					    $subid $subscription]
+			return
+		    }
+		}
+	    }
+	    if {$command != ""} {
+		# Something strange: OK without subscription details
+		eval $command [list $res]
+	    }
+	}
+    }
+
+    if {$command != ""} {
+	eval $command [list $res $child]
+    }
+}
+
+##########################################################################
+#
+# Approving subscription (8.1.6)
+#
+
+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]} {
+	set connid [jlib::route $jid]
+    }
+
+    # Let xcommands.tcl do the job
+    xcommands::execute $service $ns(get-pending) -connection $connid
+}
+
+##########################################################################
+#
+# Processing messages with authorization requests
+# is done in messages.tcl
+#
+
+##########################################################################
+#
+# Retrieve current affiliations (8.1.7)
+# Evaluates command with list of entity attributes lists
+#
+
+proc pubsub::request_affiliations {service args} {
+
+    debugmsg pubsub [info level 0]
+
+    foreach {key val} $args {
+	switch -- $key {
+	    -connection { set connid $val}
+	}
+    }
+    if {![info exists connid]} {
+	set connid [jlib::route $jid]
+    }
+
+    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]::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 == "entity"} {
+		lappend entities $vars2
+	    }
+	}
+    }
+
+    if {$command != ""} {
+	eval $command [list $res $entities]
+    }
+}
+
+##########################################################################
+#
+# Unsubscribe from pubsub node "node" at service "service" (8.1.8)
+# node must not be empty
+#
+# -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 subid args} {
+
+    debugmsg pubsub [info level 0]
+
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -jid { set jid $val }
+	    -resource { set resource $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	set connid [jlib::route $service]
+    }
+
+    if {![info exists jid]} {
+	set jid [jlib::connection_bare_jid $connid]
+	if {[info exists resource]} {
+	    append jid "/$resource"
+	}
+    }
+
+    if {$node == ""} {
+	return -code error "pubsub::unsubscribe error: Node is empty"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags [list [jlib::wrapper:createtag unsubscribe \
+				 -vars [list node $node \
+					     subid $subid \
+					     jid $jid]]]] \
+	-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]
+    }
+}
+
+##########################################################################
+#
+# Request and send subscription options form (8.1.9)
+#
+
+proc pubsub::request_subscription_options {service node subid args} {
+
+    debugmsg pubsub [info level 0]
+
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -jid { set jid $val }
+	    -resource { set resource $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	set connid [jlib::route $service]
+    }
+
+    if {![info exists jid]} {
+	set jid [jlib::connection_bare_jid $connid]
+	if {[info exists resource]} {
+	    append jid "/$resource"
+	}
+    }
+
+    if {$node == ""} {
+	return -code error \
+	    "pubsub::request_subscription_options error: Node is empty"
+    }
+
+    jlib::send_iq get \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags [list [jlib::wrapper:createtag options \
+				 -vars [list node $node \
+					     subid $subid \
+					     jid $jid]]]] \
+	-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 \
+		$entity 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
+
+    jlib::send_iq set [jlib::wrapper:createtag pubsub \
+			   -vars [list xmlns $::NS(pubsub)] \
+			   -subtags [jlib::wrapper:createtag options \
+					 -vars [list node  $node \
+						     jid   $jid \
+						     subid $subid] \
+					 -subtags $restags]] \
+	-to $service \
+	-connection $connid \
+	-command [list data::test_error_res $w]
+}
+
+##########################################################################
+#
+# Get items for a node (8.1.10)
+# Node must not be empty
+# Evaluates command with list of items
+#
+# -max_items $number (request $number last items, see example 58)
+# -items $item_id_list (request specific items, see example 60)
+
+proc pubsub::get_items {service node subid args} {
+
+    debugmsg pubsub [info level 0]
+
+    set command ""
+    set items {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -connection { set connid $val}
+	    -command { set command $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]} {
+	set connid [jlib::route $service]
+    }
+
+    if {$node == ""} {
+	return -code error "pubsub::get_items error: Node is empty"
+    }
+
+    set vars [list node $node subid $subid]
+    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 \
+		$entity tag2 vars2 isempty2 chdata2 children2
+
+	    if {$tag2 == "item"} {
+		lappend items $item
+	    }
+	}
+    }
+
+    if {$command != ""} {
+	eval $command [list $res $items]
+    }
+}
+
+##########################################################################
+#
+# Discover nodes (8.1.11) implemented in disco.tcl
+# Discover node information (8.1.12) implemented in disco.tcl
+# Discover items for a node (8.1.13) implemented in disco.tcl
+#
+
+##########################################################################
+#
+# Configure pubsub node "node" at service "service" (8.2.1)
+# node must not be empty
+#
+
+proc pubsub::configure {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]} {
+	set connid [jlib::route $service]
+    }
+
+    if {$node == ""} {
+	return -code error \
+	    "pubsub::configure error: Node is empty"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags [list [jlib::wrapper:createtag configure \
+				 -vars [list node $node]]] \
+	-to $service \
+	-connection $connid \
+	-command [list [namespace current]::configure_result \
+		       $connid $service $command]
+}
+
+proc pubsub::configure_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"} {
+	    jlib::wrapper:splitxml \
+		$entity tag2 vars2 isempty2 chdata2 children2
+	    set node [jlib::wrapper:getattr $vars2 node]
+	    break
+	}
+    }
+
+    data::draw_window $children2 \
+	[list [namespace current]::send_configure
+	      $connid $service $node $command]
+}
+
+proc pubsub::send_configure {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)] \
+			   -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.2.2)
+# TODO
+#
+
+##########################################################################
+#
+# Delete a node (8.2.3)
+# 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]} {
+	set connid [jlib::route $service]
+    }
+
+    if {$node == ""} {
+	return -code error "pubsub::delete_node error: Node is empty"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -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.2.4)
+# 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]} {
+	set connid [jlib::route $service]
+    }
+
+    if {$node == ""} {
+	return -code error "pubsub::purge_items error: Node is empty"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -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]
+    }
+}
+
+##########################################################################
+#
+# Modifying entity affiliations (8.2.5)
+# node must not be empty
+#
+
+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]} {
+	set connid [jlib::route $service]
+    }
+
+    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} {
+    global font
+    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 -font $font \
+	    -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 -font $font \
+	    -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} {
+    global font
+    variable a2m
+    variable s2m
+    variable listdata
+
+    debugmsg pubsub [info level 0]
+
+    set row $listdata($f,rows)
+
+    entry $f.jid$row -font $font \
+	-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 -font $font \
+	-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
+# TODO
+#
+
+##########################################################################
+#
+# PEP JEP-0163
+#
+
+namespace eval pep {}
+
+##########################################################################
+#
+# PEP Creating a node (4.1)
+# -access mode (mode: open, presence, roster)
+# -groups groups (roster group list if access is roster)
+# -connection is mandatory
+#
+
+proc pep::create_node {node args} {
+    variable ns
+
+    debugmsg pep [info level 0]
+
+    set command ""
+    set access "presence"
+    set groups {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -access { set access $val }
+	    -groups { set groups $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::create_node error: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::create_node error: node must not be empty"
+    }
+
+    if {$access == "roster" && $groups != {}} {
+	set form_type [jlib::wrapper:createtag field \
+			   -vars [list var FORM_TYPE \
+				       type hidden] \
+			   -subtags [list [jlib::wrapper:createtag value \
+					       -chdata $ns(pubsub#node_config)]]]
+
+	set gvalues {}
+	foreach group $groups {
+	    lappend gvalues [jlib::wrapper:createtag value -chdata $group]
+	}
+	set gfield [jlib::wrapper:createtag field \
+			-vars [list var pubsub#roster_groups_allowed] \
+			-subtags $gvalues]
+
+	set subtags [list [jlib::wrapper:createtag x
+			       -vars [list xmlns $::NS(data) \
+					   type  form] \
+			       -subtags [list $form_type $gfield]]]
+    } else {
+	set subtags {}
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags [list [jlib::wrapper:createtag create \
+				 -vars [list node $node]] \
+			    [jlib::wrapper:createtag configure \
+				 -vars [list access $access] \
+				 -subtags $subtags]]] \
+	-connection $connid \
+	-command [list [namespace current]::create_node_result \
+		       $node $command]
+}
+
+proc pep::create_node_result {node command res child} {
+
+    debugmsg pep [info level 0]
+
+    if {$command != ""} {
+	eval $command [list $node $res $child]
+    }
+}
+
+##########################################################################
+#
+# Publish item to PEP node "node" (4.2)
+# payload is a list of xml tags
+# node must not be empty
+# -connection is mandatory
+#
+
+proc pep::publish_item {node args} {
+
+    debugmsg pep [info level 0]
+
+    set command ""
+    set payload {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -payload { set payload $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::publish_item error: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::publish_item error: node must not be empty"
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags \
+		 [list [jlib::wrapper:createtag publish \
+			    -vars [list node $node] \
+			    -subtags [list [jlib::wrapper:createtag item \
+						-subtags $payload]]]]] \
+	-connection $connid \
+	-command [list [namespace current]::publish_item_result $command]
+}
+
+proc pep::publish_item_result {command res child} {
+
+    debugmsg pep [info level 0]
+
+    if {$command != ""} {
+	eval $command [list $res $child]
+    }
+}
+
+##########################################################################
+#
+# Subscribe to PEP node "node" at bare JID "to" (5.2)
+# node must not be empty
+#
+# -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 pep::subscribe {to node args} {
+
+    debugmsg pep [info level 0]
+
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -jid { set jid $val }
+	    -resource { set resource $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::subscribe error: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::subscribe error: node must not be empty"
+    }
+
+    if {![info exists jid]} {
+	set jid [jlib::connection_bare_jid $connid]
+	if {[info exists resource]} {
+	    append jid "/$resource"
+	}
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags [list [jlib::wrapper:createtag subscribe \
+				 -vars [list node $node jid $jid]]]] \
+	-to $to \
+	-connection $connid \
+	-command [list [namespace current]::subscribe_result $command]
+}
+
+proc pep::subscribe_result {command res child} {
+
+    debugmsg pep [info level 0]
+
+    if {$command != ""} {
+	eval $command [list $res $child]
+    }
+}
+
+##########################################################################
+#
+# Unsubscribe from PEP node "node" at bare JID "to" (undocumented?!)
+# node must not be empty
+#
+# -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 pep::unsubscribe {to node args} {
+
+    debugmsg pep [info level 0]
+
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -jid { set jid $val }
+	    -resource { set resource $val }
+	    -connection { set connid $val}
+	    -command { set command $val }
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::unsubscribe error: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::unsubscribe error: node must not be empty"
+    }
+
+    if {![info exists jid]} {
+	set jid [jlib::connection_bare_jid $connid]
+	if {[info exists resource]} {
+	    append jid "/$resource"
+	}
+    }
+
+    jlib::send_iq set \
+	[jlib::wrapper:createtag pubsub \
+	     -vars [list xmlns $::NS(pubsub)] \
+	     -subtags [list [jlib::wrapper:createtag unsubscribe \
+				 -vars [list node $node jid $jid]]]] \
+	-to $to \
+	-connection $connid \
+	-command [list [namespace current]::unsubscribe_result $command]
+}
+
+proc pep::unsubscribe_result {command res child} {
+
+    debugmsg pep [info level 0]
+
+    if {$command != ""} {
+	eval $command [list $res $child]
+    }
+}
+
+##########################################################################
+


Property changes on: trunk/tkabber/pubsub.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native



More information about the Tkabber-dev mailing list