[Tkabber-dev] r1371 - branches/xml-import-export-serialized/plugins/roster

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Feb 3 19:04:59 MSK 2008


Author: kostix
Date: 2008-02-03 19:04:58 +0300 (Sun, 03 Feb 2008)
New Revision: 1371

Modified:
   branches/xml-import-export-serialized/plugins/roster/TODO
   branches/xml-import-export-serialized/plugins/roster/annotations.tcl
   branches/xml-import-export-serialized/plugins/roster/backup.tcl
   branches/xml-import-export-serialized/plugins/roster/bkup_annotations.tcl
   branches/xml-import-export-serialized/plugins/roster/bkup_conferences.tcl
   branches/xml-import-export-serialized/plugins/roster/conferences.tcl
Log:
plugins/roster/backup.tcl: Implemented kind of framework to allow
 serialized evaluation of scripts registered on the deserialization step.
 vwait'ing for arrival of restored roster contacts is eliminated.

plugins/roster/conferences.tcl: [store_bookmarks] now accepts an optional
 list of option/value pairs. "-command" option is processed and provides for
 overriding of a handler that will be called by jabberlib after getting
 the response to IQ query for storage of bookmarks.

plugins/roster/annotations.tcl: Same changes as in conferences.tcl made to
 the [store_notes] proc. [cleanup_and_store_notes] also changed to accept
 an optional list of option/value pairs which is handed unmodified to
 [store_notes].

plugins/roster/bkup_annotations.tcl, plugins/roster/bkup_conferences.tcl:
 Changed to make restoration of their respective roster data to work
 with the new framework implemented in backup.tcl.

plugins/roster/TODO: Tasks updated.

TODO: A problems with fetching proper categories and subtypes for the
 restored roster items remains.


Modified: branches/xml-import-export-serialized/plugins/roster/TODO
===================================================================
--- branches/xml-import-export-serialized/plugins/roster/TODO	2008-02-03 01:33:42 UTC (rev 1370)
+++ branches/xml-import-export-serialized/plugins/roster/TODO	2008-02-03 16:04:58 UTC (rev 1371)
@@ -1,17 +1,3 @@
-* Probably rethink the logic once more: in theory, it could be
-  possible to populate roster with restored contacts w/o
-  sending them to the server (which could be done independently,
-  at any time). In this case we don't have to synchronize
-  with restoring annotations.
-
-  It could go like this:
-  * We add some data to the roster array;
-  * Schedule the iq set query with roster contacts;
-  * Allow other plugins to fire the handlers they've installed
-    in the deserialize_roster_hook -- they will see "correct"
-	roster even if the corresponding roster push wasn't yet
-	performed.
-
 * Gateways and "gated" contacts doesn't appear to have correct
   category/subtype -- investigate whether it's possible to
   use that heuristic mechs to get them on the fly as they're

Modified: branches/xml-import-export-serialized/plugins/roster/annotations.tcl
===================================================================
--- branches/xml-import-export-serialized/plugins/roster/annotations.tcl	2008-02-03 01:33:42 UTC (rev 1370)
+++ branches/xml-import-export-serialized/plugins/roster/annotations.tcl	2008-02-03 16:04:58 UTC (rev 1371)
@@ -108,7 +108,7 @@
     }
 }
 
-proc annotations::cleanup_and_store_notes {connid} {
+proc annotations::cleanup_and_store_notes {connid args} {
     variable notes
 
     set roster_jids {}
@@ -128,7 +128,7 @@
 	}
     }
 
-    store_notes $connid
+    eval [list store_notes $connid] $args
 }
 
 proc annotations::serialize_notes {connid} {
@@ -163,9 +163,20 @@
 	-subtags $notelist
 }
 
-proc annotations::store_notes {connid} {
+proc annotations::store_notes {connid args} {
+    set command [list [namespace current]::store_notes_result $connid]
+    foreach {opt val} $args {
+	switch -- $opt {
+	    -command { set command $val }
+	    default {
+		return -code error "Bad option \"$opt\":\
+		    must be -command"
+	    }
+	}
+    }
+
     private::store [list [serialize_notes $connid]] \
-	-command [list [namespace current]::store_notes_result $connid] \
+	-command $command \
 	-connection $connid
 }
 

Modified: branches/xml-import-export-serialized/plugins/roster/backup.tcl
===================================================================
--- branches/xml-import-export-serialized/plugins/roster/backup.tcl	2008-02-03 01:33:42 UTC (rev 1370)
+++ branches/xml-import-export-serialized/plugins/roster/backup.tcl	2008-02-03 16:04:58 UTC (rev 1371)
@@ -21,9 +21,6 @@
 	[namespace current]::serialize_roster_contacts
     hook::add deserialize_roster_hook \
 	[namespace current]::deserialize_roster_contacts
-
-    hook::add roster_push_hook \
-	[namespace current]::process_roster_push
 }
 
 ###############################################################################
@@ -167,19 +164,31 @@
 	    must be \"$NS(rosterbackup)\""
     }
 
-    set handlers [list]
-    hook::run deserialize_roster_hook $connid $children #[info level] handlers
+    set tuples [list]
+    hook::run deserialize_roster_hook $connid $children #[info level] tuples
 
-    foreach handler [lsort -integer -index 0 $handlers] {
-	namespace eval :: [lindex $handler 1]
+    if {[llength $tuples] > 0} {
+	set scripts [list]
+	foreach tuple [lsort -integer -index 0 $tuples] {
+	    lappend scripts [lindex $tuple 1]
+	}
+	[namespace current]::run_deserialization_scripts $scripts
     }
 }
 
 ###############################################################################
 
+proc rosterbackup::run_deserialization_scripts {scripts} {
+    if {[llength $scripts] == 0} return
+
+    uplevel #0 [linsert [lindex $scripts 0] end \
+	[list [lindex [info level 0] 0] [lrange $scripts 1 end]]]
+}
+
+###############################################################################
+
 proc rosterbackup::deserialize_roster_contacts {connid data level varName} {
     global NS
-    variable sent
     upvar $level $varName handlers
 
     array set existing {}
@@ -214,53 +223,57 @@
 	lappend handlers [list 50 [namespace code [list \
 	    send_contacts $connid $subtags]]]
     }
+
+    lappend handlers [list 1000 [namespace code [list \
+	show_restore_completion_dialog $connid]]]
 }
 
 ###############################################################################
 
-proc rosterbackup::send_contacts {connid contacts} {
+proc rosterbackup::get_item_jid {data} {
+    jlib::wrapper:splitxml $data ? vars ? ? ?
+    jlib::wrapper:getattr $vars jid
+}
+
+###############################################################################
+
+proc rosterbackup::send_contacts {connid contacts continuation} {
     global NS
 
     puts "handler: roster contacts"
 
-    set status [namespace current]::sent($connid,status)
-    set $status WAITING
-
     jlib::send_iq set \
 	[jlib::wrapper:createtag query \
 	     -vars [list xmlns $NS(roster)] \
 	     -subtags $contacts] \
-	-connection $connid
-
-    vwait $status
-    unset $status
+	-connection $connid \
+	-command [namespace code [list process_send_result $continuation]]
 }
 
 ###############################################################################
 
-proc rosterbackup::get_item_jid {data} {
-    jlib::wrapper:splitxml $data ? vars ? ? ?
-    jlib::wrapper:getattr $vars jid
+proc rosterbackup::process_send_result {continuation result xmldata} {
+    switch -- $result {
+	OK {
+	    eval $continuation
+	}
+	default {
+	    # TODO check whether do we need to handle TIMEOUT specially
+	    tk_messageBox -icon error -parent . \
+		-title [::msgcat::mc "Error"] \
+		-message [::msgcat::mc "Error restoring roster contacts: %s" \
+		    [error_to_string $xmldata]]
+	}
+    }
 }
 
 ###############################################################################
 
-proc rosterbackup::process_roster_push {connid jid name groups subsc ask} {
-    variable sent
-    upvar 0 sent($connid,status) status
-    upvar 0 sent($connid,jids) jids
-
-    if {[info exists status]} {
-	set ix [lsearch -exact $jids $jid]
-	if {$ix >= 0} {
-	    if {[llength $jids] == 1} {
-		unset jids
-		set status COMPLETE
-	    } else {
-		set jids [lreplace $jids $ix $ix]
-	    }
-	}
-    }
+proc rosterbackup::show_restore_completion_dialog {connid continuation} {
+    tk_messageBox -icon info -parent . \
+	-title [::msgcat::mc "Information"] \
+	-message [::msgcat::mc "Roster restoration completed"]
+    eval $continuation
 }
 
 # vim:ts=8:sw=4:sts=4:noet

Modified: branches/xml-import-export-serialized/plugins/roster/bkup_annotations.tcl
===================================================================
--- branches/xml-import-export-serialized/plugins/roster/bkup_annotations.tcl	2008-02-03 01:33:42 UTC (rev 1370)
+++ branches/xml-import-export-serialized/plugins/roster/bkup_annotations.tcl	2008-02-03 16:04:58 UTC (rev 1371)
@@ -58,7 +58,7 @@
 
 ###############################################################################
 
-proc annobackup::send_notes {connid notes} {
+proc annobackup::send_notes {connid notes continuation} {
     set updated 0
 
     puts "handler: annotations"
@@ -70,8 +70,28 @@
     }
 
     if {$updated} {
-	::plugins::annotations::cleanup_and_store_notes $connid
+	::plugins::annotations::cleanup_and_store_notes $connid \
+	    -command [namespace code [list process_sending_result $continuation]]
+    } else {
+	eval $continuation
     }
 }
 
+###############################################################################
+
+proc annobackup::process_sending_result {continuation result xmldata} {
+    switch -- $result {
+	OK {
+	    eval $continuation
+	}
+	default {
+	    # TODO check whether do we need to handle TIMEOUT specially
+	    tk_messageBox -icon error -parent . \
+		-title [::msgcat::mc "Error"] \
+		-message [::msgcat::mc "Error restoring annotations: %s" \
+		    [error_to_string $xmldata]]
+	}
+    }
+}
+
 # vim:ts=8:sw=4:sts=4:noet

Modified: branches/xml-import-export-serialized/plugins/roster/bkup_conferences.tcl
===================================================================
--- branches/xml-import-export-serialized/plugins/roster/bkup_conferences.tcl	2008-02-03 01:33:42 UTC (rev 1370)
+++ branches/xml-import-export-serialized/plugins/roster/bkup_conferences.tcl	2008-02-03 16:04:58 UTC (rev 1371)
@@ -62,7 +62,7 @@
 
 ###############################################################################
 
-proc mucbackup::merge_muc_bookmarks {connid bookmarks bmgroups} {
+proc mucbackup::merge_muc_bookmarks {connid bookmarks bmgroups continuation} {
     variable updated 0
 
     puts "handler: bookmarks"
@@ -80,9 +80,29 @@
     }
 
     if {$updated} {
+	::plugins::conferences::store_bookmarks $connid \
+	    -command [namespace code [list process_merging_result $continuation]]
 	::plugins::conferences::push_bookmarks_to_roster $connid
-	::plugins::conferences::store_bookmarks $connid
+    } else {
+	eval $continuation
     }
 }
 
+###############################################################################
+
+proc mucbackup::process_merging_result {continuation result xmldata} {
+    switch -- $result {
+	OK {
+	    eval $continuation
+	}
+	default {
+	    # TODO check whether TIMEOUT should be processed separately
+	    tk_messageBox -icon error -parent . \
+		-title [::msgcat::mc "Error"] \
+		-message [::msgcat::mc "Error restoring conference bookmarks: %s" \
+		    [error_to_string $xmldata]]
+	}
+    }
+}
+
 # vim:ts=8:sw=4:sts=4:noet

Modified: branches/xml-import-export-serialized/plugins/roster/conferences.tcl
===================================================================
--- branches/xml-import-export-serialized/plugins/roster/conferences.tcl	2008-02-03 01:33:42 UTC (rev 1370)
+++ branches/xml-import-export-serialized/plugins/roster/conferences.tcl	2008-02-03 16:04:58 UTC (rev 1371)
@@ -256,10 +256,21 @@
 	    -subtags $grouplist]
 }
 
-proc conferences::store_bookmarks {connid} {
+proc conferences::store_bookmarks {connid args} {
+    set command [list [namespace current]::store_bookmarks_result $connid]
+    foreach {opt val} $args {
+	switch -- $opt {
+	    -command { set command $val }
+	    default {
+		return -code error "Bad option \"$opt\":\
+		    must be -command"
+	    }
+	}
+    }
+
     foreach item [serialize_bookmarks $connid] {
 	private::store [list $item] \
-	    -command [list [namespace current]::store_bookmarks_result $connid] \
+	    -command $command \
 	    -connection $connid
     }
 }



More information about the Tkabber-dev mailing list