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

codesite-noreply at google.com codesite-noreply at google.com
Sun Feb 15 23:57:32 MSK 2009


Author: sgolovan
Date: Sun Feb 15 11:18:56 2009
New Revision: 78

Modified:
    trunk/ChangeLog
    trunk/xmpp/annotations.tcl
    trunk/xmpp/bookmarks.tcl
    trunk/xmpp/delimiter.tcl
    trunk/xmpp/metacontacts.tcl

Log:
	* xmpp/annotations.tcl, xmpp/bookmarks.tcl, xmpp/delimiter.tcl,
	  xmpp/metacontacts.tcl: Added serialize/deserialize procedures
	  which convert from/to internal representaton to/from XML. They
	  are useful in roster export/import routines.


Modified: trunk/ChangeLog
==============================================================================
--- trunk/ChangeLog	(original)
+++ trunk/ChangeLog	Sun Feb 15 11:18:56 2009
@@ -1,3 +1,10 @@
+2009-02-15  Sergei Golovan  <sgolovan at nes.ru>
+
+	* xmpp/annotations.tcl, xmpp/bookmarks.tcl, xmpp/delimiter.tcl,
+	  xmpp/metacontacts.tcl: Added serialize/deserialize procedures
+	  which convert from/to internal representaton to/from XML. They
+	  are useful in roster export/import routines.
+
  2009-02-12  Sergei Golovan  <sgolovan at nes.ru>

  	* xmpp/metacontacts.tcl: Made interface to retrieve/store procedures

Modified: trunk/xmpp/annotations.tcl
==============================================================================
--- trunk/xmpp/annotations.tcl	(original)
+++ trunk/xmpp/annotations.tcl	Sun Feb 15 11:18:56 2009
@@ -14,7 +14,9 @@

  package provide xmpp::roster::annotations 0.1

-namespace eval ::xmpp::roster::annotations {}
+namespace eval ::xmpp::roster::annotations {
+    namespace export store retrieve serialize deserialize
+}

  proc ::xmpp::roster::annotations::retrieve {xlib args} {
      set commands {}
@@ -52,6 +54,11 @@
          uplevel #0 [lindex $commands 0] [list $status $xml]
      }

+    uplevel #0 [lindex $commands 0] [list ok [deserialize $xml]]
+    return
+}
+
+proc ::xmpp::roster::annotations::deserialize {xml} {
      set notes {}

      foreach xmldata $xml {
@@ -77,8 +84,7 @@
          }
      }

-    uplevel #0 [lindex $commands 0] [list ok $notes]
-    return
+    return $notes
  }

  proc ::xmpp::roster::annotations::ScanTime {timestamp} {
@@ -89,7 +95,7 @@
      }
  }

-proc ::xmpp::roster::annotations::SerializeNotes {notes} {
+proc ::xmpp::roster::annotations::serialize {notes} {
      set tags {}
      foreach note $notes {
          array unset n
@@ -140,7 +146,7 @@
      set id \
          [::xmpp::private::store \
                      $xlib \
-                    [list [SerializeNotes $notes]] \
+                    [list [serialize $notes]] \
                      -command [namespace code [list ProcessStoreAnswer  
$commands]] \
                      -timeout $timeout]
      return $id

Modified: trunk/xmpp/bookmarks.tcl
==============================================================================
--- trunk/xmpp/bookmarks.tcl	(original)
+++ trunk/xmpp/bookmarks.tcl	Sun Feb 15 11:18:56 2009
@@ -14,7 +14,9 @@

  package provide xmpp::roster::bookmarks 0.1

-namespace eval ::xmpp::roster::bookmarks {}
+namespace eval ::xmpp::roster::bookmarks {
+    namespace export store retrieve serialize deserialize
+}

  proc ::xmpp::roster::bookmarks::retrieve {xlib args} {
      set commands {}
@@ -52,6 +54,11 @@
          uplevel #0 [lindex $commands 0] [list $status $xml]
      }

+    uplevel #0 [lindex $commands 0] [list ok [deserialize $xml]]
+    return
+}
+
+proc ::xmpp::roster::bookmarks::deserialize {xml} {
      set bookmarks {}

      foreach xmldata $xml {
@@ -92,11 +99,10 @@
          }
      }

-    uplevel #0 [lindex $commands 0] [list ok $bookmarks]
-    return
+    return $bookmarks
  }

-proc ::xmpp::roster::bookmarks::SerializeBookmarks {bookmarks} {
+proc ::xmpp::roster::bookmarks::serialize {bookmarks} {
      set tags {}
      foreach bookmark $bookmarks {
          array unset n
@@ -154,7 +160,7 @@
      set id \
          [::xmpp::private::store \
                      $xlib \
-                    [list [SerializeBookmarks $bookmarks]] \
+                    [list [serialize $bookmarks]] \
                      -command [namespace code [list ProcessStoreAnswer  
$commands]] \
                      -timeout $timeout]
      return $id

Modified: trunk/xmpp/delimiter.tcl
==============================================================================
--- trunk/xmpp/delimiter.tcl	(original)
+++ trunk/xmpp/delimiter.tcl	Sun Feb 15 11:18:56 2009
@@ -14,13 +14,15 @@

  package provide xmpp::roster::delimiter 0.1

-namespace eval ::xmpp::roster::delimiter {}
+namespace eval ::xmpp::roster::delimiter {
+    namespace export store retrieve serialize deserialize
+}

  #
  # Retrieving nested groups delimiter
  #

-proc ::xmpp::roster::delimiter::retrieve {xlib fallback args} {
+proc ::xmpp::roster::delimiter::retrieve {xlib args} {
      set commands {}
      set timeout 0

@@ -45,35 +47,42 @@
                      [list [::xmpp::xml::create roster \
                                                 -xmlns roster:delimiter]] \
                      -command [namespace code [list ParseRetrieveResult \
-                                                   $fallback \
                                                     $commands] \
                      -timeout $timeout]
      return $id
  }

-proc ::xmpp::roster::delimiter::ParseRetireveResult {fallback commands  
status xml} {
+proc ::xmpp::roster::delimiter::ParseRetireveResult {commands status xml} {
      if {[llength $commands] == 0} return

-    set delimiter $fallback
+    if {![string equal $status ok]} {
+        uplevel #0 [lindex $commands 0] [list $status $xml]
+    }
+
+    uplevel #0 [lindex $commands 0] [list ok [deserialize $xml]]
+    return
+}

-    if {[string equal $status ok]} {
-        foreach item $xml {
-            ::xmpp::xml::split $item tag xmlns attrs cdata subels
+proc ::xmpp::roster::delimiter::deserialize {xml} {
+    foreach item $xml {
+        ::xmpp::xml::split $item tag xmlns attrs cdata subels

-            if {[string equal $xmlns roster:delimiter]} {
-                set delimiter $cdata
-            }
+        if {[string equal $xmlns roster:delimiter]} {
+            return $cdata
          }
      }
-
-    uplevel #0 [lindex $commands 0] [list $delimiter]
-    return
  }

  #
  # Storing nested groups delimiter
  #

+proc ::xmpp::roster::delimiter::serialize {delimiter} {
+    return [::xmpp::xml::create roster \
+                                -xmlns roster:delimiter \
+                                -cdata $delimiter]
+}
+
  proc ::xmpp::roster::delimiter::store {xlib delimiter args} {
      set commands {}
      set timeout 0
@@ -96,9 +105,7 @@
      set id \
          [::xmpp::private::store \
                      $xlib \
-                    [list [::xmpp::xml::create roster \
-                                               -xmlns roster:delimiter \
-                                               -cdata $delimiter]] \
+                    [list [serialize $delimiter]] \
                      -command [namespace code [list ParseStoreResult  
$commands]] \
                      -timeout $timeout]
      return $id

Modified: trunk/xmpp/metacontacts.tcl
==============================================================================
--- trunk/xmpp/metacontacts.tcl	(original)
+++ trunk/xmpp/metacontacts.tcl	Sun Feb 15 11:18:56 2009
@@ -14,7 +14,9 @@

  package provide xmpp::roster::metacontacts 0.1

-namespace eval ::xmpp::roster::metacontacts {}
+namespace eval ::xmpp::roster::metacontacts {
+    namespace export store retrieve serialize deserialize
+}

  proc ::xmpp::roster::metacontacts::retrieve {xlib args} {
      set commands {}
@@ -52,6 +54,11 @@
          uplevel #0 [lindex $commands 0] [list $status $xml]
      }

+    uplevel #0 [lindex $commands 0] [list ok [deserialize $xml]]
+    return
+}
+
+proc ::xmpp::roster::metacontacts::deserialize {xml} {
      foreach xmldata $xml {
          ::xmpp::xml::split $xmldata tag xmlns attrs cdata subels

@@ -77,8 +84,24 @@
          }
      }

-    uplevel #0 [lindex $commands 0] [list ok [array get result]]
-    return
+    return [array get result]
+}
+
+proc ::xmpp::roster::metacontacts::serialize {contacts} {
+    set tags {}
+    foreach {tag jids} $contacts {
+        set order 1
+        foreach jid $jids {
+            set attrs [list jid $jid tag $tag order $order]
+
+            lappend tags [::xmpp::xml::create meta -attrs $attrs]
+            incr order
+        }
+    }
+
+    return [::xmpp::xml::create storage \
+                                -xmlns storage:metacontacts \
+                                -subelements $tags]
  }

  proc ::xmpp::roster::metacontacts::store {xlib contacts args} {
@@ -100,23 +123,10 @@
          }
      }

-    set tags {}
-    foreach {tag jids} $contacts {
-        set order 1
-        foreach jid $jids {
-            set attrs [list jid $jid tag $tag order $order]
-
-            lappend tags [::xmpp::xml::create meta -attrs $attrs]
-            incr order
-        }
-    }
-
      set id \
          [::xmpp::private::store \
                      $xlib \
-                    [list [::xmpp::xml::create storage \
-                                        -xmlns storage:metacontacts \
-                                        -subelements $tags]] \
+                    [list [serialize $contacts]] \
                      -command [namespace code [list ProcessStoreAnswer  
$commands]] \
                      -timeout $timeout]
      return $id


More information about the Tkabber-dev mailing list