[Tkabber-dev] r1355 - in branches/xml-import-export: . ifacetk jabberlib plugins/roster

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Jan 28 22:23:49 MSK 2008


Author: kostix
Date: 2008-01-28 22:23:49 +0300 (Mon, 28 Jan 2008)
New Revision: 1355

Added:
   branches/xml-import-export/plugins/roster/backup.tcl
Modified:
   branches/xml-import-export/ifacetk/iroster.tcl
   branches/xml-import-export/jabberlib/wrapper.tcl
   branches/xml-import-export/roster.tcl
Log:
jabberlib/wrapper.tcl: [wrapper:createxml] adjusted to take arbitrary
 number of Tk-style option/value pairs. -xmlns, -prettyprint and -level
 are supported. Implemented XML pretty-printing if -prettyprint set to true.

plugins/roster/backup.tcl: Created new internal plugin to implement generic
 code to manage XML-based roster backup files. New backup code from
 roster.tcl moved here. Implemented hooks for serialization/deserialization
 for different kinds of roster items. Main menu management moved here also.

ifacetk/iroster.tcl: Code related to manipulation of main menu
 entries related to roster import/export moved to plugins/roster/backup.tcl

roster.tcl: Reverted to original version before the branch was created.


Modified: branches/xml-import-export/ifacetk/iroster.tcl
===================================================================
--- branches/xml-import-export/ifacetk/iroster.tcl	2008-01-28 17:39:01 UTC (rev 1354)
+++ branches/xml-import-export/ifacetk/iroster.tcl	2008-01-28 19:23:49 UTC (rev 1355)
@@ -1908,43 +1908,6 @@
 
 ###############################################################################
 
-proc roster::setup_import_export_menus {args} {
-    set emenu [.mainframe getmenu export_roster]
-    set imenu [.mainframe getmenu import_roster]
-
-    if {[winfo exists $emenu]} {
-	destroy $emenu
-    }
-    menu $emenu -tearoff 0
-
-    if {[winfo exists $imenu]} {
-	destroy $imenu
-    }
-    menu $imenu -tearoff 0
-
-    if {[jlib::connections] == {}} {
-	.mainframe setmenustate export_roster disabled
-	.mainframe setmenustate import_roster disabled
-    } else {
-	.mainframe setmenustate export_roster normal
-	.mainframe setmenustate import_roster normal
-    }
-
-    foreach c [jlib::connections] {
-	set jid [jlib::connection_jid $c]
-	set label [format [::msgcat::mc "Roster of %s"] $jid]
-	set ecommand [list roster::export_to_xml_file $c]
-	set icommand [list roster::import_from_xml_file $c]
-	$emenu add command -label $label -command $ecommand
-	$imenu add command -label $label -command $icommand
-    }
-}
-hook::add connected_hook [namespace current]::roster::setup_import_export_menus
-hook::add disconnected_hook [namespace current]::roster::setup_import_export_menus
-hook::add finload_hook [namespace current]::roster::setup_import_export_menus
-
-###############################################################################
-
 proc roster::add_group_custom_presence_menu {m connid name} {
     set mm [menu $m.custom_presence -tearoff 0]
 

Modified: branches/xml-import-export/jabberlib/wrapper.tcl
===================================================================
--- branches/xml-import-export/jabberlib/wrapper.tcl	2008-01-28 17:39:01 UTC (rev 1354)
+++ branches/xml-import-export/jabberlib/wrapper.tcl	2008-01-28 19:23:49 UTC (rev 1355)
@@ -223,14 +223,29 @@
 #
 # This procedure converts (and returns) $xmldata to raw-XML
 #
-proc wrapper:createxml {xmldata {xmlns jabber:client}} {
+proc wrapper:createxml {xmldata args} {
+    set xmlns jabber:client
+    set prettyprint 0
+    set level 0
+    foreach {opt val} $args {
+	switch -- $opt {
+	    -xmlns { set xmlns $val }
+	    -level { set level $val }
+	    -prettyprint { set prettyprint $val }
+	    default {
+		return -code error "Bad option \"$opt\":\
+		    must be one of -xmlns, -level or -prettyprint"
+	    }
+	}
+    }
+
     set retext ""
 
-    set tagname [lindex $xmldata 0]
-    set vars    [lindex $xmldata 1]
-    set subtags [lindex $xmldata 2]
-    set chdata  [lindex $xmldata 3]
+    lassign $xmldata tagname vars subtags chdata
 
+    if {$prettyprint && $level} {
+	append retext [string repeat \t $level]
+    }
     append retext "<$tagname"
     foreach {attr value} $vars {
 	if {$attr == "xmlns"} {
@@ -242,20 +257,32 @@
 	}
 	append retext " $attr='[wrapper:xmlcrypt $value]'"
     }
-    if {$chdata == "" && [llength $subtags] == 0} {
+
+    set no_chdata [expr {$chdata == ""}]
+    if {$no_chdata && [llength $subtags] == 0} {
 	append retext "/>"
+	if {$prettyprint} { append retext \n }
 	return $retext
-    } else {
-	append retext ">"
     }
 
-    append retext [wrapper:xmlcrypt $chdata]
+    append retext ">"
 
+    if {!$no_chdata} {
+	append retext [wrapper:xmlcrypt $chdata]
+    } elseif {$prettyprint} {
+	append retext \n
+    }
+
     foreach subdata $subtags {
-	append retext [wrapper:createxml $subdata $xmlns]
+	append retext [wrapper:createxml $subdata -xmlns $xmlns \
+	    -prettyprint $prettyprint -level [expr {$level + 1}]]
     }
 
+    if {$prettyprint && $no_chdata && $level} {
+	append retext [string repeat \t $level]
+    }
     append retext "</$tagname>"
+    if {$prettyprint && $level} { append retext \n }
 
     return $retext
 }
@@ -390,3 +417,4 @@
     return "</stream:stream>"
 }
 
+# vim:ts=8:sw=4:sts=4:noet

Added: branches/xml-import-export/plugins/roster/backup.tcl
===================================================================
--- branches/xml-import-export/plugins/roster/backup.tcl	                        (rev 0)
+++ branches/xml-import-export/plugins/roster/backup.tcl	2008-01-28 19:23:49 UTC (rev 1355)
@@ -0,0 +1,236 @@
+# $Id$
+# Export/import of the roster items using an XML file.
+# This code provides basic framework for handling roster backup
+# files and it's able to serialize/deserialize regular roster
+# contacts. Hooks provided to make possible storage of other
+# kinds of data in roster backup files.
+
+namespace eval rosterbackup {
+    variable rootns http://tkabber.jabber.ru/contactlist
+
+    hook::add connected_hook \
+	[namespace current]::setup_import_export_menus
+    hook::add disconnected_hook \
+	[namespace current]::setup_import_export_menus
+    hook::add finload_hook \
+	[namespace current]::setup_import_export_menus
+
+    hook::add serialize_roster_hook \
+	[namespace current]::serialize_roster_contacts
+    hook::add deserialize_roster_hook \
+	[namespace current]::deserialize_roster_contacts
+}
+
+###############################################################################
+
+proc rosterbackup::setup_import_export_menus {args} {
+    set emenu [.mainframe getmenu export_roster]
+    set imenu [.mainframe getmenu import_roster]
+
+    if {[winfo exists $emenu]} {
+	destroy $emenu
+    }
+    menu $emenu -tearoff 0
+
+    if {[winfo exists $imenu]} {
+	destroy $imenu
+    }
+    menu $imenu -tearoff 0
+
+    if {[jlib::connections] == {}} {
+	.mainframe setmenustate export_roster disabled
+	.mainframe setmenustate import_roster disabled
+    } else {
+	.mainframe setmenustate export_roster normal
+	.mainframe setmenustate import_roster normal
+    }
+
+    foreach c [jlib::connections] {
+	set jid [jlib::connection_jid $c]
+	set label [format [::msgcat::mc "Roster of %s"] $jid]
+	set ecommand [list [namespace current]::export_to_file $c]
+	set icommand [list [namespace current]::import_from_file $c]
+	$emenu add command -label $label -command $ecommand
+	$imenu add command -label $label -command $icommand
+    }
+}
+
+###############################################################################
+
+proc rosterbackup::export_to_file {connid} {
+    set filename [tk_getSaveFile \
+		      -initialdir $::configdir \
+		      -initialfile [jlib::connection_user $connid]-roster.xml \
+		      -filetypes [list \
+				      [list [::msgcat::mc "Roster Files"] \
+					   .xml] \
+				      [list [::msgcat::mc "All Files"] *]]]
+    if {$filename == ""} return
+
+    set fd [open $filename w]
+    fconfigure $fd -encoding utf-8
+
+    puts $fd [serialize_roster $connid]
+
+    close $fd
+}
+
+###############################################################################
+
+proc rosterbackup::serialize_roster {connid} {
+    variable rootns
+
+    set subtags [list]
+    hook::run serialize_roster_hook $connid #[info level] subtags
+
+    jlib::wrapper:createxml [jlib::wrapper:createtag contactlist \
+	    -vars [list xmlns $rootns] -subtags $subtags] \
+	-prettyprint 1
+}
+
+###############################################################################
+
+proc rosterbackup::serialize_roster_contacts {connid level varName} {
+    upvar $level $varName subtags
+
+    variable ::roster::roster
+    # TODO change to something more reasonable:
+    variable ::plugins::conferences::bookmarks
+
+    set items [list]
+    foreach jid $roster(jids,$connid) {
+	if {![info exists bookmarks($connid,jid,$jid)]} {
+	    lappend items [::roster::item_to_xml $connid $jid]
+	}
+    }
+
+    lappend subtags [jlib::wrapper:createtag roster \
+	-vars {xmlns jabber:iq:roster} \
+	-subtags $items]
+}
+
+###############################################################################
+
+proc rosterbackup::import_from_file {connid} {
+    set filename [tk_getOpenFile \
+		      -initialdir $::configdir \
+		      -initialfile [jlib::connection_user $connid]-roster.xml \
+		      -filetypes [list \
+				      [list [::msgcat::mc "Roster Files"] \
+					   .xml] \
+				      [list [::msgcat::mc "All Files"] *]]]
+    if {$filename == ""} return
+
+    set fd [open $filename r]
+    fconfigure $fd -encoding utf-8
+    set xml [read $fd]
+    close $fd
+
+    deserialize_roster $connid $xml
+
+    if 0 {
+    if {$items != {}} {
+	jlib::send_iq set \
+	    [jlib::wrapper:createtag query \
+		 -vars [list xmlns "jabber:iq:roster"] \
+		 -subtags $items] \
+	    -connection $connid
+    }
+    }
+}
+
+###############################################################################
+
+proc rosterbackup::deserialize_roster {connid data} {
+    set parser [jlib::wrapper:new "#" "#" \
+	[list [namespace current]::parse_roster_xml $connid]]
+    jlib::wrapper:elementstart $parser stream:stream {} {}
+    jlib::wrapper:parser $parser parse $data
+    jlib::wrapper:parser $parser configure -final 0
+    jlib::wrapper:free $parser
+}
+
+###############################################################################
+
+proc rosterbackup::parse_roster_xml {connid data} {
+    variable rootns
+
+    jlib::wrapper:splitxml $data tag vars isempty chdata children
+
+    if {![string equal $tag contactlist]} {
+	return -code error "Bad root element \"$tag\":\
+	    must be contactlist"
+    }
+    # TODO fix it:
+    if 0 {
+    set ix [lsearch -exact $vars xmlns]
+    if {![string equal [lindex $vars $ix] $rootns]} {
+	return -code error "Bad file format:\
+	    root element doesn't posess a proper \"xmlns\" attribute"
+    }
+    }
+
+    array set seen {}
+    foreach child $children {
+	jlib::wrapper:splitxml $child ctag cvars cisempty cchdata cchildren
+	if {[info exists seen($ctag)]} {
+	    return -code error "At most one \"$ctag\" section is allowed"
+	}
+	hook::run roster_deserialize_hook $connid \
+		$ctag $cvars $cisempty $cchdata $cchildren
+	set seen($ctag) {}
+    }
+}
+
+###############################################################################
+
+proc rosterbackup::deserialize_roster_contacts {connid
+	tag vars isempty cdata children} {
+    if {![string equal $tag roster]} return
+    # TODO check xmlns for presence and validity
+
+    variable ::roster::roster
+
+    foreach child $children {
+	puts "another roster contact..."
+    }
+}
+
+###############################################################################
+
+# TODO drop it
+proc rosterbackup::xml_parse_roster_item {data} {
+    jlib::wrapper:splitxml $data tag vars isempty chdata children
+
+    set out [list]
+
+    foreach child $children {
+	jlib::wrapper:splitxml $child ctag cvars cisempty cchdata cchildren
+
+	set vars [list jid [jlib::wrapper:getattr $cvars jid]]
+
+	foreach item {name subscription ask} {
+	    set val [jlib::wrapper:getattr $cvars $item]
+	    if {$val != ""} {
+		lappend vars $item $val]
+	    }
+	}
+
+	set grtags [list]
+	foreach subchild $cchildren {
+	    jlib::wrapper:splitxml $subchild subtag tmp tmp subchdata tmp
+
+	    switch -- $subtag {
+		group {
+		    lappend grtags [jlib::wrapper:createtag group -chdata $subchdata]
+		}
+	    }
+	}
+
+	lappend out [jlib::wrapper:createtag item -vars $vars -subtags $grtags]
+    }
+
+    set out
+}
+
+# vim:ts=8:sw=4:sts=4:noet


Property changes on: branches/xml-import-export/plugins/roster/backup.tcl
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

Modified: branches/xml-import-export/roster.tcl
===================================================================
--- branches/xml-import-export/roster.tcl	2008-01-28 17:39:01 UTC (rev 1354)
+++ branches/xml-import-export/roster.tcl	2008-01-28 19:23:49 UTC (rev 1355)
@@ -708,153 +708,4 @@
 
 ###############################################################################
 
-proc roster::export_to_xml_file {connid} {
-    set filename [tk_getSaveFile \
-		      -initialdir $::configdir \
-		      -initialfile [jlib::connection_user $connid]-roster.xml \
-		      -filetypes [list \
-				      [list [::msgcat::mc "Roster Files"] \
-					   .xml] \
-				      [list [::msgcat::mc "All Files"] *]]]
-    if {$filename == ""} return
-
-    set fd [open $filename w]
-    fconfigure $fd -encoding utf-8
-
-    puts $fd [serialize_to_xml $connid]
-
-    close $fd
-}
-
-proc roster::serialize_to_xml {connid} {
-    variable roster
-
-    set items [list]
-    foreach jid $roster(jids,$connid) {
-	lappend items [item_to_xml $connid $jid]
-    }
-
-    jlib::wrapper:createxml [jlib::wrapper:createtag contactlist \
-	-vars {xmlns http://tkabber.jabber.ru/contactlist} \
-	-subtags [list \
-	    [jlib::wrapper:createtag roster \
-		-vars {xmlns jabber:iq:roster} \
-		-subtags $items]]]
-}
-
-proc roster::import_from_xml_file {connid} {
-    set filename [tk_getOpenFile \
-		      -initialdir $::configdir \
-		      -initialfile [jlib::connection_user $connid]-roster.xml \
-		      -filetypes [list \
-				      [list [::msgcat::mc "Roster Files"] \
-					   .xml] \
-				      [list [::msgcat::mc "All Files"] *]]]
-    if {$filename == ""} return
-
-    set fd [open $filename r]
-    fconfigure $fd -encoding utf-8
-    set xml [read $fd]
-    close $fd
-
-    lassign [deserialize_from_xml $xml] roster bookmarks
-    puts "roster $roster\nbookmarks: $bookmarks"
-
-    if 0 {
-    if {$items != {}} {
-	jlib::send_iq set \
-	    [jlib::wrapper:createtag query \
-		 -vars [list xmlns "jabber:iq:roster"] \
-		 -subtags $items] \
-	    -connection $connid
-    }
-    }
-}
-
-proc roster::deserialize_from_xml {data} {
-    set parser [jlib::wrapper:new "#" "#" \
-	[namespace current]::xml_parse]
-    jlib::wrapper:elementstart $parser stream:stream {} {}
-    puts [info level]
-    set items [jlib::wrapper:parser $parser parse $data]
-    jlib::wrapper:parser $parser configure -final 0
-    jlib::wrapper:free $parser
-    return $items
-}
-
-proc roster::xml_parse {resultVar data} {
-    puts [info level]
-
-    jlib::wrapper:splitxml $data tag vars isempty chdata children
-
-    if {![string equal $tag contactlist]} {
-	return -code error "Bad root element \"$tag\":\
-	    must be contactlist"
-    }
-
-    set roster    {}
-    set bookmarks {}
-
-    foreach child $children {
-	jlib::wrapper:splitxml $child ctag cvars cisempty cchdata cchildren
-	switch -- $ctag {
-	    roster {
-		if {$roster != ""} {
-		    return -code error "At most one roster section is allowed"
-		}
-		set roster $cchildren
-	    }
-	    bookmarks {
-		if {$bookmarks != ""} {
-		    return -code error "At most one bookmarks section is allowed"
-		}
-		set bookmarks $cchildren
-	    }
-	    default {
-		return -code error "Bad element: \"$ctag\":\
-		    must be one of roster or bookmarks"
-	    }
-	}
-    }
-
-    list $roster $bookmarks
-}
-
-# TODO drop it
-proc roster::xml_parse_roster_item {data} {
-    jlib::wrapper:splitxml $data tag vars isempty chdata children
-
-    set out [list]
-
-    foreach child $children {
-	jlib::wrapper:splitxml $child ctag cvars cisempty cchdata cchildren
-
-	set vars [list jid [jlib::wrapper:getattr $cvars jid]]
-
-	foreach item {name subscription ask} {
-	    set val [jlib::wrapper:getattr $cvars $item]
-	    if {$val != ""} {
-		lappend vars $item $val]
-	    }
-	}
-
-	set grtags [list]
-	foreach subchild $cchildren {
-	    jlib::wrapper:splitxml $subchild subtag tmp tmp subchdata tmp
-
-	    switch -- $subtag {
-		group {
-		    lappend grtags [jlib::wrapper:createtag group -chdata $subchdata]
-		}
-	    }
-	}
-
-	lappend out [jlib::wrapper:createtag item -vars $vars -subtags $grtags]
-    }
-
-    set out
-}
-
-###############################################################################
-
 # vim:ts=8:sw=4:sts=4:noet



More information about the Tkabber-dev mailing list