[Tkabber-dev] r1602 - in trunk/tkabber-plugins: . jidlink jidlink/plugins

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Nov 3 15:38:08 MSK 2008


Author: sergei
Date: 2008-11-03 15:38:08 +0300 (Mon, 03 Nov 2008)
New Revision: 1602

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/jidlink/jidlink.tcl
   trunk/tkabber-plugins/jidlink/plugins/filetransfer.tcl
Log:
	* jidlink/jidlink.tcl: Rewritten to use xmpp::negotiate package for
	  method negotiation.

	* jidlink/plugins/filetransfer.tcl: A few bugfixes.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2008-11-03 07:14:37 UTC (rev 1601)
+++ trunk/tkabber-plugins/ChangeLog	2008-11-03 12:38:08 UTC (rev 1602)
@@ -1,3 +1,10 @@
+2008-11-03  Sergei Golovan <sgolovan at nes.ru>
+
+	* jidlink/jidlink.tcl: Rewritten to use xmpp::negotiate package for
+	  method negotiation.
+
+	* jidlink/plugins/filetransfer.tcl: A few bugfixes.
+
 2008-10-26  Sergei Golovan <sgolovan at nes.ru>
 
 	* floatingcontact/msgs/de.msg: Updated German translation (thanks to

Modified: trunk/tkabber-plugins/jidlink/jidlink.tcl
===================================================================
--- trunk/tkabber-plugins/jidlink/jidlink.tcl	2008-11-03 07:14:37 UTC (rev 1601)
+++ trunk/tkabber-plugins/jidlink/jidlink.tcl	2008-11-03 12:38:08 UTC (rev 1602)
@@ -1,6 +1,7 @@
 # $Id$
 
 package require msgcat
+package require xmpp::negotiate
 
 namespace eval ::jidlink {
 
@@ -60,15 +61,36 @@
 	return
     }
 
-    lassign [negotiate::send_request $xlib $jid jabber:iq:jidlink $options] res opts
+    ::xmpp::negotiate::sendOptions $xlib $jid jabber:iq:jidlink $options \
+	    -command [namespace code [list negotiate_recv_response \
+					   $xlib $jid $key $options]]
+}
 
-    if {[llength $opts] == 1 && [lcontain $options [lindex $opts 0]]} {
-	set name [lindex $opts 0]
-	set connection(transport,$key) $name
-	eval $transport(connect,$name) [list $xlib $jid $key]
-	set connection(status,$key) 1
+proc ::jidlink::negotiate_recv_response {xlib jid key options status opts} {
+    variable connection
+    variable transport
+
+    if {$status != "ok"} {
+	set connection(status,$key) 0
 	return
     }
+
+    foreach {tag field} $opts {
+	if {$tag != "field"} continue
+
+	lassign $field var type label values
+
+	if {$var != "jabber:iq:jidlink"} continue
+
+	set name [lindex $values 0]
+	if {[lsearch -exact $options $name] >= 0} {
+	    set connection(transport,$key) $name
+	    eval $transport(connect,$name) [list $xlib $jid $key]
+	    set connection(status,$key) 1
+	    return
+	}
+    }
+
     set connection(status,$key) 0
 }
 
@@ -121,9 +143,7 @@
     }
 }
 
-
-# TODO: xlib
-proc ::jidlink::negotiate_handler {from type options} {
+proc ::jidlink::negotiate_handler {xlib from options args} {
     variable transport
 
     set trans [lsort -unique -index 1 $transport(list)]
@@ -137,20 +157,22 @@
     }
 
     if {$options == {}} {
+	# Options request
+
 	return $myoptions
+    } else {
+	foreach opt $options {
+	    if {[lsearch -exact $myoptions $opt] >= 0} {
+		return [list $opt]
+	    }
+	}
     }
 
-    foreach opt $options {
-	if {[lcontain $myoptions $opt]} {
-	    return [list $opt]
-	}
-    }
     return {}
 }
 
-negotiate::register_handler jabber:iq:jidlink ::jidlink::negotiate_handler
+::xmpp::negotiate::register jabber:iq:jidlink ::jidlink::negotiate_handler
 
-
 proc ::jidlink::set_handler {xlib from xml args} {
     debugmsg jidlink "set: [list $from $xml]"
 

Modified: trunk/tkabber-plugins/jidlink/plugins/filetransfer.tcl
===================================================================
--- trunk/tkabber-plugins/jidlink/plugins/filetransfer.tcl	2008-11-03 07:14:37 UTC (rev 1601)
+++ trunk/tkabber-plugins/jidlink/plugins/filetransfer.tcl	2008-11-03 12:38:08 UTC (rev 1602)
@@ -49,8 +49,9 @@
 
     if {[cequal $status ok]} return
 
-    eval $state(command) error \
-	 [list [::msgcat::mc "Request failed: %s" [error_to_string $xml]]]
+    eval $state(command) \
+	[list error \
+	      [::msgcat::mc "Request failed: %s" [error_to_string $xml]]]
 }
 
 ###############################################################################
@@ -101,7 +102,7 @@
 
     if {$res == 0} {
 	if {[info exists state(command)]} {
-	    eval $state(command) error [::msgcat::mc "Jidlink connection failed"]
+	    eval $state(command) [list error [::msgcat::mc "Jidlink connection failed"]]
 	}
 	return
     }
@@ -116,13 +117,13 @@
 	     while {$chunk != ""} {
 		 jidlink::send_data $state(key) $chunk
 		 update idletasks
-		 eval $state(command) [list PROGRESS [tell $state(fd)]]
+		 eval $state(command) [list progress [tell $state(fd)]]
 		 after 1000
 		 set chunk [read $state(fd) $chunk_size]
 	     }
 	 }]} {
 	if {[info exists state(command)]} {
-	    eval $state(command) error [::msgcat::mc "Jidlink transfer failed"]
+	    eval $state(command) [list error [::msgcat::mc "Jidlink transfer failed"]]
 	}
 	return
     }
@@ -246,7 +247,7 @@
 	-query [::xmpp::xml::create query \
 		    -xmlns jabber:iq:filexfer \
 		    -subelement [::xmpp::xml::create file \
-					-attrs [list id $id]]]] \
+					-attrs [list id $id]]] \
 	-to $user \
 	-command [list [namespace current]::recv_file_reply \
 		       $winid $size $pbvar $user $lang $id $filename]
@@ -377,9 +378,9 @@
 ###############################################################################
 
 proc ftjl::iq_set_handler {xlib from xml args} {
-    debugmsg filetransfer "FTJL set: [list $from $child]"
+    debugmsg filetransfer "FTJL set: [list $from $xml]"
 
-    ::xmpp::xml::split $child tag xmlns attrs cdata subels
+    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
 
     if {$tag != "query"} {
 	return {error modify bad-request}



More information about the Tkabber-dev mailing list