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

codesite-noreply at google.com codesite-noreply at google.com
Sun Nov 2 11:05:09 MSK 2008


Author: sgolovan
Date: Sun Nov  2 01:04:47 2008
New Revision: 55

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

Log:
	* xmpp/data.tcl: Added a procedure which fills in form fields for
	  submission.

	* xmpp/search.tcl, xmpp/pkgIndex.tcl: Added a package which implements
	  support for Jabber Search (XEP-0055) queries.


Modified: trunk/ChangeLog
==============================================================================
--- trunk/ChangeLog	(original)
+++ trunk/ChangeLog	Sun Nov  2 01:04:47 2008
@@ -1,6 +1,14 @@
+2008-11-02  Sergei Golovan  <sgolovan at nes.ru>
+
+	* xmpp/data.tcl: Added a procedure which fills in form fields for
+	  submission.
+
+	* xmpp/search.tcl, xmpp/pkgIndex.tcl: Added a package which implements
+	  support for Jabber Search (XEP-0055) queries.
+
  2008-11-01  Sergei Golovan  <sgolovan at nes.ru>

-	* xmpp/xdata.tcl, xmpp/pkgIndex.tcl: Added a new package for working
+	* xmpp/data.tcl, xmpp/pkgIndex.tcl: Added a new package for working
  	  with data forms (XEP-0004).

  	* xmpp/data.tcl: Return form type when searching for a data form.

Modified: trunk/xmpp/data.tcl
==============================================================================
--- trunk/xmpp/data.tcl	(original)
+++ trunk/xmpp/data.tcl	Sun Nov  2 01:04:47 2008
@@ -16,6 +16,26 @@

  namespace eval ::xmpp::data {}

+# ::xmpp::data::submitForm --
+
+proc ::xmpp::data::submitForm {fields} {
+    set subels {}
+    foreach {var values} $fields {
+        set vsubels {}
+        foreach value $values {
+            lappend vsubels [::xmpp::xml::create value -cdata $value]
+        }
+        lappend subels [::xmpp::xml::create field \
+                                -attrs [list var $var] \
+                                -subelements $vsubels]
+    }
+
+    return [::xmpp::xml::create x \
+                    -xmlns jabber:x:data \
+                    -attrs [list type submit] \
+                    -subelements $subels]
+}
+
  # ::xmpp::data::findForm --

  proc ::xmpp::data::findForm {xmlElements} {

Modified: trunk/xmpp/pkgIndex.tcl
==============================================================================
--- trunk/xmpp/pkgIndex.tcl	(original)
+++ trunk/xmpp/pkgIndex.tcl	Sun Nov  2 01:04:47 2008
@@ -26,6 +26,7 @@
  package ifneeded xmpp::jid 0.1             [list source [file join $dir  
jid.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]]
  package ifneeded xmpp::stanzaerror 0.1     [list source [file join $dir  
stanzaerror.tcl]]
  package ifneeded xmpp::starttls 0.1        [list source [file join $dir  
starttls.tcl]]
  package ifneeded xmpp::streamerror 0.1     [list source [file join $dir  
streamerror.tcl]]

Added: trunk/xmpp/search.tcl
==============================================================================
--- (empty file)
+++ trunk/xmpp/search.tcl	Sun Nov  2 01:04:47 2008
@@ -0,0 +1,197 @@
+# search.tcl --
+#
+#       This file is a part of the XMPP library. It implements support for
+#       Jabber search (XEP-0055).
+#
+# 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::search 0.1
+
+namespace eval ::xmpp::search {
+    namespace export request submit
+
+    # Search fields (see XEP-0055)
+
+    array set labels [list jid   [::msgcat::mc "Jabber ID"] \
+                           first [::msgcat::mc "First Name"] \
+                           last  [::msgcat::mc "Last Name"] \
+                           nick  [::msgcat::mc "Nickname"] \
+                           email [::msgcat::mc "E-mail"]]
+}
+
+# ::xmpp::search::request --
+
+proc ::xmpp::search::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:search] \
+                    -to $jid \
+                    -command [namespace code [list ParseForm $command]]]
+}
+
+# ::xmpp::search::submit --
+
+proc ::xmpp::search::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:search \
+                                    -subelements $subels] \
+                    -to $jid \
+                    -command [namespace code [list ParseResult $command]]]
+}
+
+# ::xmpp::search::ParseForm --
+
+proc ::xmpp::search::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 $items]
+        set old true
+    }
+
+    uplevel #0 $command [list $status $fields -old $old]
+    return
+}
+
+# ::xmpp::search::ParseFields --
+
+proc ::xmpp::search::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 {
+                if {[info exists labels($tag)]} {
+                    set label $labels($tag)
+                } else {
+                    set label $tag
+                }
+
+                lappend res field \
+                        [list $tag text-single $label "" false {} [list  
$cdata] {}]
+            }
+        }
+    }
+
+    return $res
+}
+
+# ::xmpp::search::FillFields --
+
+proc ::xmpp::search::FillFields {fields} {
+    set res {}
+    foreach {var values} $fields {
+        lappend res [::xmpp::xml::create $var -cdata [lindex $values 0]]
+    }
+    return $res
+}
+
+# ::xmpp::search::ParseResult --
+
+proc ::xmpp::search::ParseResult {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 result]} {
+        set fields [::xmpp::data::parseResult $form]
+    } else {
+        set fields [ParseLegacyItems $subels]
+    }
+
+    uplevel #0 $command [list $status $fields]
+    return
+}
+
+# ::xmpp::search::ParseLegacyItems --
+
+proc ::xmpp::search::ParseItems {items} {
+    variable labels
+
+    set res {}
+    set reported(jid) $labels(jid)
+
+    foreach item $items {
+        ::xmpp::xml::split $item tag xmlns attrs cdata subels
+
+        switch -- $tag {
+            item {
+                set itemjid [::xmpp::xml::getAttr $attrs jid]
+                set fields [list jid $itemjid]
+
+                foreach field $subels {
+                    ::xmpp::xml::split $field stag sxmlns sattrs scdata  
ssubels
+                    lappend fields $stag $scdata
+                    if {[info exists labels($stag)]} {
+                        set reported($stag) $labels($stag)
+                    } else {
+                        set reported($stag) ""
+                    }
+                }
+            }
+        }
+        lappend res item $fields
+    }
+
+    return [linsert $res 0 reported [array get $reported]]
+}
+
+# vim:ft=tcl:ts=8:sw=4:sts=4:et


More information about the Tkabber-dev mailing list