[Tkabber-dev] [tclxmpp commit] r56 - in trunk: . xmpp

codesite-noreply at google.com codesite-noreply at google.com
Sun Nov 2 12:47:18 MSK 2008


Author: sgolovan
Date: Sun Nov  2 01:46:50 2008
New Revision: 56

Added:
    trunk/xmpp/register.tcl   (contents, props changed)
Modified:
    trunk/ChangeLog
    trunk/xmpp/data.tcl
    trunk/xmpp/pkgIndex.tcl
    trunk/xmpp/search.tcl

Log:
	* xmpp/data.tcl: Treat missing form type as "form".

	* xmpp/search.tcl: Fixed typo and removed implicit field label.

	* xmpp/register.tcl, xmpp/pkgIndex.tcl: Added a new package which
	  implements support for In-Band Registration (XEP-0077) queries.


Modified: trunk/ChangeLog
==============================================================================
--- trunk/ChangeLog	(original)
+++ trunk/ChangeLog	Sun Nov  2 01:46:50 2008
@@ -6,6 +6,13 @@
  	* xmpp/search.tcl, xmpp/pkgIndex.tcl: Added a package which implements
  	  support for Jabber Search (XEP-0055) queries.

+	* xmpp/data.tcl: Treat missing form type as "form".
+
+	* xmpp/search.tcl: Fixed typo and removed implicit field label.
+
+	* xmpp/register.tcl, xmpp/pkgIndex.tcl: Added a new package which
+	  implements support for In-Band Registration (XEP-0077) queries.
+
  2008-11-01  Sergei Golovan  <sgolovan at nes.ru>

  	* xmpp/data.tcl, xmpp/pkgIndex.tcl: Added a new package for working

Modified: trunk/xmpp/data.tcl
==============================================================================
--- trunk/xmpp/data.tcl	(original)
+++ trunk/xmpp/data.tcl	Sun Nov  2 01:46:50 2008
@@ -42,7 +42,7 @@
      foreach xmlElement $xmlElements {
          ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
          if {[string equal $xmlns jabber:x:data]} {
-            set type [::xmpp::xml::getAttr $attrs type]
+            set type [::xmpp::xml::getAttr $attrs type form]
              return [list $type $xmlElement]
          }
      }

Modified: trunk/xmpp/pkgIndex.tcl
==============================================================================
--- trunk/xmpp/pkgIndex.tcl	(original)
+++ trunk/xmpp/pkgIndex.tcl	Sun Nov  2 01:46:50 2008
@@ -24,6 +24,7 @@
  package ifneeded xmpp::dns 0.1             [list source [file join $dir  
dns.tcl]]
  package ifneeded xmpp::iq 0.1              [list source [file join $dir  
iq.tcl]]
  package ifneeded xmpp::jid 0.1             [list source [file join $dir  
jid.tcl]]
+package ifneeded xmpp::register 0.1        [list source [file join $dir  
register.tcl]]
  package ifneeded xmpp::roster 0.1          [list source [file join $dir  
roster.tcl]]
  package ifneeded xmpp::sasl 0.1            [list source [file join $dir  
sasl.tcl]]
  package ifneeded xmpp::search 0.1          [list source [file join $dir  
search.tcl]]

Added: trunk/xmpp/register.tcl
==============================================================================
--- (empty file)
+++ trunk/xmpp/register.tcl	Sun Nov  2 01:46:50 2008
@@ -0,0 +1,187 @@
+# register.tcl --
+#
+#       This file is a part of the XMPP library. It implements support for
+#       In-Band Registration (XEP-0077).
+#
+# Copyright (c) 2008 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.
+#
+# $Id$
+
+package require xmpp
+
+package provide xmpp::register 0.1
+
+namespace eval ::xmpp::register {
+    namespace export request submit
+
+    # Register fields (see XEP-0077)
+
+    array set labels [list username [::msgcat::mc "Username"] \
+	                   nick     [::msgcat::mc "Nickname"] \
+	                   password [::msgcat::mc "Password"] \
+	                   name     [::msgcat::mc "Full Name"] \
+	                   first    [::msgcat::mc "First Name"] \
+	                   last     [::msgcat::mc "Last Name"] \
+	                   email    [::msgcat::mc "E-mail"] \
+	                   address  [::msgcat::mc "Address"] \
+	                   city     [::msgcat::mc "City"] \
+	                   state    [::msgcat::mc "State"] \
+	                   zip      [::msgcat::mc "Zip"] \
+	                   phone    [::msgcat::mc "Phone"] \
+	                   url      [::msgcat::mc "URL"] \
+	                   date     [::msgcat::mc "Date"] \
+	                   misc     [::msgcat::mc "Misc"] \
+	                   text     [::msgcat::mc "Text"] \
+	                   key      [::msgcat::mc "Key"]]
+}
+
+# ::xmpp::register::request --
+
+proc ::xmpp::register::request {xlib jid args} {
+    set command #
+    foreach {key val} $args {
+        switch -- $key {
+            -command {
+                set command $val
+            }
+        }
+    }
+
+    return [::xmpp::sendIQ $xlib get \
+                    -query [::xmpp::xml::create query \
+                                    -xmlns jabber:iq:register] \
+                    -to $jid \
+                    -command [namespace code [list ParseForm $command]]]
+}
+
+# ::xmpp::register::submit --
+
+proc ::xmpp::register::submit {xlib jid fields args} {
+    set old false
+    set command #
+    foreach {key val} $args {
+        switch -- $key {
+            -old {
+                set old $val
+            }
+            -command {
+                set command $val
+            }
+        }
+    }
+
+    if {!$old} {
+        set subels [list [::xmpp::data::submitForm $fields]]
+    } else {
+        set subels [FillFields $fields]
+    }
+
+    return [::xmpp::sendIQ $xlib set \
+                    -query [::xmpp::xml::create query \
+                                    -xmlns jabber:iq:register \
+                                    -subelements $subels] \
+                    -to $jid \
+                    -command $command]
+}
+
+# ::xmpp::register::remove --
+
+proc ::xmpp::register::remove {xlib jid args} {
+    set command #
+    foreach {key val} $args {
+        switch -- $key {
+            -command {
+                set command $val
+            }
+        }
+    }
+
+    return [::xmpp::sendIQ $xlib set \
+	            -query [::xmpp::xml::create query \
+			            -xmlns jabber:iq:register \
+			            -subelement [::xmpp::xml::create remove]] \
+	            -to $jid \
+	            -command $command]
+}
+
+# ::xmpp::register::ParseForm --
+
+proc ::xmpp::register::ParseForm {command status xml} {
+    if {![string equal $status ok]} {
+        uplevel #0 $command [list $status $xml]
+        return
+    }
+
+    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
+
+    foreach {type form} [::xmpp::data::findForm $subels] break
+
+    if {[string equal $type form]} {
+        set fields [::xmpp::data::parseForm $form]
+        set old false
+    } else {
+        set fields [ParseFields $subels]
+        set old true
+    }
+
+    uplevel #0 $command [list $status $fields -old $old]
+    return
+}
+
+# ::xmpp::register::ParseFields --
+
+proc ::xmpp::register::ParseFields {xmlElements} {
+    variable labels
+
+    set res {}
+    foreach xml $xmlElements {
+        ::xmpp::xml::split $xml tag xmlns attrs cdata subels
+
+        switch -- $tag {
+            instructions {
+                set res [linsert $res 0 instructions $cdata]
+            }
+            x {}
+            default {
+                switch -- $tag {
+                    key -
+                    registered {
+                        set type hidden
+                    }
+                    password {
+                        set type text-private
+                    }
+                    default {
+                        set type text-single
+                    }
+                }
+
+                if {[info exists labels($tag)]} {
+                    set label $labels($tag)
+                } else {
+                    set label ""
+                }
+
+                lappend res field \
+                        [list $tag $type $label "" false {} [list $cdata]  
{}]
+            }
+        }
+    }
+
+    return $res
+}
+
+# ::xmpp::register::FillFields --
+
+proc ::xmpp::register::FillFields {fields} {
+    set res {}
+    foreach {var values} $fields {
+        lappend res [::xmpp::xml::create $var -cdata [lindex $values 0]]
+    }
+    return $res
+}
+
+# vim:ft=tcl:ts=8:sw=4:sts=4:et

Modified: trunk/xmpp/search.tcl
==============================================================================
--- trunk/xmpp/search.tcl	(original)
+++ trunk/xmpp/search.tcl	Sun Nov  2 01:46:50 2008
@@ -91,7 +91,7 @@
          set fields [::xmpp::data::parseForm $form]
          set old false
      } else {
-        set fields [ParseFields $items]
+        set fields [ParseFields $subels]
          set old true
      }

@@ -117,7 +117,7 @@
                  if {[info exists labels($tag)]} {
                      set label $labels($tag)
                  } else {
-                    set label $tag
+                    set label ""
                  }

                  lappend res field \


More information about the Tkabber-dev mailing list