[Tkabber-dev] [tclxmpp] r174 committed - * xmpp/xmpp.tcl: Added function which returns the current XMPP stream...

tclxmpp at googlecode.com tclxmpp at googlecode.com
Sun Feb 2 21:12:46 MSK 2014


Revision: 174
Author:   sgolovan
Date:     Sun Feb  2 17:12:34 2014 UTC
Log:      	* xmpp/xmpp.tcl: Added function which returns the current XMPP  
stream
	  features.

	* xmpp/roster.tcl: Implemented roster versioning as in XEP-0237
	  and later in RFC-6121 (thanks to Jan Zachorowski).

http://code.google.com/p/tclxmpp/source/detail?r=174

Modified:
  /trunk/ChangeLog
  /trunk/xmpp/roster.tcl
  /trunk/xmpp/xmpp.tcl

=======================================
--- /trunk/ChangeLog	Thu Jan 30 14:37:15 2014 UTC
+++ /trunk/ChangeLog	Sun Feb  2 17:12:34 2014 UTC
@@ -1,3 +1,11 @@
+2014-02-02  Sergei Golovan  <sgolovan at nes.ru>
+
+	* xmpp/xmpp.tcl: Added function which returns the current XMPP stream
+	  features.
+
+	* xmpp/roster.tcl: Implemented roster versioning as in XEP-0237
+	  and later in RFC-6121 (thanks to Jan Zachorowski).
+
  2014-01-30  Sergei Golovan  <sgolovan at nes.ru>

  	* xmpp/sasl.tcl: Send XMPP session IQ only if it's present in the
=======================================
--- /trunk/xmpp/roster.tcl	Fri Jan 29 15:14:25 2010 UTC
+++ /trunk/xmpp/roster.tcl	Sun Feb  2 17:12:34 2014 UTC
@@ -1,9 +1,9 @@
  # roster.tcl --
  #
  #       This file is a part of the XMPP library. It implements basic
-#       roster routines (RFC-3291).
+#       roster routines (RFC-3921 and RFC-6121).
  #
-# Copyright (c) 2008-2010 Sergei Golovan <sgolovan at nes.ru>
+# Copyright (c) 2008-2014 Sergei Golovan <sgolovan at nes.ru>
  #
  # See the file "license.terms" for information on usage and redistribution
  # of this file, and for a DISCLAMER OF ALL WARRANTIES.
@@ -15,6 +15,25 @@
  package provide xmpp::roster 0.1

  namespace eval ::xmpp::roster {}
+
+# ::xmpp::roster::features --
+#
+#       Return roster features list it can be empty or include 'ver' string
+#       which means that roster versioning is supported (XEP-0237 and later
+#       RFC-6121, section 2.6)
+
+proc ::xmpp::roster::features {xlib} {
+    set features {}
+    foreach f [::xmpp::streamFeatures $xlib] {
+        ::xmpp::xml::split $f tag xmlns attrs cdata subels
+
+        if {[string equal $tag var] &&
+                [string equal $xmlns urn:xmpp:features:rosterver]} {
+            lappend features ver
+        }
+    }
+    set features
+}

  # ::xmpp::roster::new --

@@ -32,9 +51,13 @@
      set state(xlib) $xlib
      set state(rid) 0
      set state(items) {}
+    set state(-version) ""
+    set state(-cache) {}

      foreach {key val} $args {
          switch -- $key {
+            -version -
+            -cache -
              -itemcommand {
                  set state($key) $val
              }
@@ -48,7 +71,7 @@

      ::xmpp::iq::RegisterIQ $xlib set * jabber:iq:roster \
                             [namespace code [list ParsePush $token]]
-    return $token
+    set token
  }

  # ::xmpp::roster::free --
@@ -60,11 +83,13 @@
      if {![info exists state(xlib)]} return

      set xlib $state(xlib)
+    set version $state(-version)
+    set cache $state(-cache)

      ::xmpp::iq::UnregisterIQ $xlib set * jabber:iq:roster

      unset state
-    return
+    list $version $cache
  }

  # ::xmpp::roster::items --
@@ -199,6 +224,7 @@
      set xlib $state(xlib)

      set timeout 0
+    set attrs {}
      set cmd {}

      foreach {key val} $args {
@@ -215,12 +241,19 @@
              }
          }
      }
+
+    if {[lsearch -exact [features $xlib] ver] >= 0} {
+        lappend attrs ver $state(-version)
+    }

      set rid [incr state(rid)]
+    set state(items) {}
+    array unset state roster,*

      ::xmpp::sendIQ $xlib get \
                     -query [::xmpp::xml::create query \
-                                               -xmlns jabber:iq:roster] \
+                                               -xmlns jabber:iq:roster \
+                                               -attrs $attrs] \
                     -command [namespace code [list ParseAnswer $token \
                                                                $rid \
                                                                $cmd]] \
@@ -268,9 +301,9 @@
          return [list error cancel service-unavailable]
      }

-    ParseItems $token $xmlElement
+    ParseItems $token push $xmlElement

-    return [list result [::xmpp::xml::create query -xmlns  
jabber:iq:roster]]
+    return [list result {}]
  }

  # ::xmpp::roster::ParseAnswer --
@@ -286,7 +319,7 @@
      ::xmpp::Debug $xlib 2 "$token $rid '$cmd' $status"

      if {[string equal $status ok]} {
-        ParseItems $token $xmlElement
+        ParseItems $token fetch $xmlElement
          set xmlElement ""
      }

@@ -301,11 +334,48 @@

  # ::xmpp::roster::ParseItems --

-proc ::xmpp::roster::ParseItems {token xmlElement} {
+proc ::xmpp::roster::ParseItems {token mode xmlElement} {
      variable $token
      upvar 0 $token state

+    if {$xmlElement == {}} {
+        # Empty result, so use the cached roster
+
+        set items {}
+        foreach item $state(cache) {
+            lassign $item njid jid name subsc ask groups
+
+            lappend items $njid
+
+            set state(roster,$njid) [list jid          $jid \
+                                          name         $name \
+                                          subscription $subsc \
+                                          ask          $ask \
+                                          groups       $groups]
+
+            if {[info exists state(-itemcommand)]} {
+                uplevel #0 $state(-itemcommand) [list $njid \
+                                                      -jid          $jid \
+                                                      -name         $name \
+                                                      -subscription $subsc  
\
+                                                      -ask          $ask \
+                                                      -groups        
$groups]
+            }
+        }
+
+        set state(items) [lsort -unique $items]
+        return
+    }
+
      ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
+
+    # Get the new roster version
+    set state(-version) [::xmpp::xml::getAttr $attrs ver ""]
+
+    # Empty cache but not while roster push
+    if {[string equal $mode fetch]} {
+        set state(-cache) {}
+    }

      foreach subel $subels {
          ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
@@ -336,6 +406,11 @@
                  if {$idx >= 0} {
                      set state(items) [lreplace $state(items) $idx $idx]
                  }
+
+                set idx [lsearch -exact -index 0 $state(-cache) $njid]
+                if {$idx >= 0} {
+                    set state(-cache) [lreplace $state(-cache) $idx $idx]
+                }

                  catch {unset state(roster,$njid)}
              }
@@ -350,6 +425,9 @@
                                                subscription $subsc \
                                                ask          $ask \
                                                groups       $groups]
+
+                lappend state(-cache) \
+                        [list $njid $jid $name $subsc $ask $groups]
              }
          }

=======================================
--- /trunk/xmpp/xmpp.tcl	Tue Dec  3 11:10:12 2013 UTC
+++ /trunk/xmpp/xmpp.tcl	Sun Feb  2 17:12:34 2014 UTC
@@ -624,6 +624,30 @@
      }
      return
  }
+
+# ::xmpp::streamFeatures --
+#
+#       Return the current stream features list.
+#
+# Arguments:
+#       xlib            XMPP token.
+#
+# Result:
+#       Features list.
+#
+# Side effects:
+#       Features list is taken from the state variable.
+
+proc ::xmpp::streamFeatures {xlib} {
+    variable $xlib
+    upvar 0 $xlib state
+
+    if {[info exists state(features)]} {
+        return $state(features)
+    } else {
+        return {}
+    }
+}

  # ::xmpp::ParseStreamFeatures --
  #


More information about the Tkabber-dev mailing list