[Tkabber-dev] r1170 - in trunk/tkabber: . plugins plugins/pep

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Aug 1 19:28:24 MSD 2007


Author: sergei
Date: 2007-08-01 19:28:23 +0400 (Wed, 01 Aug 2007)
New Revision: 1170

Added:
   trunk/tkabber/pep.tcl
   trunk/tkabber/plugins/pep/
   trunk/tkabber/plugins/pep/user_mood.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/pubsub.tcl
   trunk/tkabber/tkabber.tcl
Log:
	* pep.tcl, pubsub.tcl, tkabber.tcl: Moved personal evening support to
	  a separate file (thanks to Konstantin Khomoutov).

	* plugins/pep/user_mood.tcl: Added user mood (XEP-107) support as an
	  exercise on personal eventing (thanks to Konstantin Khomoutov).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-07-31 17:15:30 UTC (rev 1169)
+++ trunk/tkabber/ChangeLog	2007-08-01 15:28:23 UTC (rev 1170)
@@ -1,3 +1,11 @@
+2007-08-01  Sergei Golovan  <sgolovan at nes.ru>
+
+	* pep.tcl, pubsub.tcl, tkabber.tcl: Moved personal evening support to
+	  a separate file (thanks to Konstantin Khomoutov).
+
+	* plugins/pep/user_mood.tcl: Added user mood (XEP-107) support as an
+	  exercise on personal eventing (thanks to Konstantin Khomoutov).
+
 2007-07-31  Sergei Golovan  <sgolovan at nes.ru>
 
 	* jabberlib-tclxml/tclxml/xml-8.1.tcl: Fixed tokenizing regexp to

Added: trunk/tkabber/pep.tcl
===================================================================
--- trunk/tkabber/pep.tcl	                        (rev 0)
+++ trunk/tkabber/pep.tcl	2007-08-01 15:28:23 UTC (rev 1170)
@@ -0,0 +1,189 @@
+# $Id$
+# Personal eventing via pubsub XEP-0163
+
+namespace eval pep {}
+
+##########################################################################
+#
+# PEP Creating a node (5)
+# -connection is mandatory
+# -access_model (open, presence (default), roster, whitelist)
+# -roster_groups_allowed (roster group list if access is roster)
+#
+
+proc pep::create_node {node args} {
+    variable ns
+
+    debugmsg pep [info level 0]
+
+    set command ""
+    set access "presence"
+    set groups {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -connection { set connid $val}
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::create_node: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::create_node: node must not be empty"
+    }
+
+    set service [jlib::connection_bare_jid $connid]
+
+    eval [list pubsub::create_node $service $node] $args
+}
+
+##########################################################################
+#
+# Publish item to PEP node "node" (8)
+# payload is a list of xml tags
+# node must not be empty
+# -connection is mandatory
+#
+
+proc pep::publish_item {node args} {
+
+    debugmsg pep [info level 0]
+
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -connection { set connid $val}
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::publish_item: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::publish_item: node must not be empty"
+    }
+
+    set service [jlib::connection_bare_jid $connid]
+
+    eval [list pubsub::publish_item $service $node ""] $args
+}
+
+##########################################################################
+#
+# Subscribe to PEP node "node" at bare JID "to" (5.2)
+# node must not be empty
+#
+# -jid "jid" is optional (when it's present it's included to sub request)
+#
+# -resource "res" is optional (when it's present bare_jid/res is included
+# to sub request
+#
+# if both options are absent then user's bare JID is included to sub
+# request
+#
+
+proc pep::subscribe {to node args} {
+
+    debugmsg pep [info level 0]
+
+    foreach {key val} $args {
+	switch -- $key {
+	    -connection { set connid $val}
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::subscribe error: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::subscribe error: node must not be empty"
+    }
+
+    eval [list pubsub::subscribe $to $node] $args
+}
+
+##########################################################################
+#
+# Unsubscribe from PEP node "node" at bare JID "to" (undocumented?!)
+# node must not be empty
+#
+# -jid "jid" is optional (when it's present it's included to sub request)
+#
+# -resource "res" is optional (when it's present bare_jid/res is included
+# to sub request
+#
+# if both options are absent then user's bare JID is included to sub
+# request
+#
+
+proc pep::unsubscribe {to node args} {
+
+    debugmsg pep [info level 0]
+
+    set command ""
+    foreach {key val} $args {
+	switch -- $key {
+	    -connection { set connid $val}
+	}
+    }
+
+    if {![info exists connid]} {
+	return -code error "pep::unsubscribe error: -connection is mandatory"
+    }
+
+    if {$node == ""} {
+	return -code error "pep::unsubscribe error: node must not be empty"
+    }
+
+    eval [list pubsub::unsubscribe $to $node] $args
+}
+
+##########################################################################
+# Returns a name of a submenu (of menu $m) for PEP commands to perform on
+# the roster item for a user with JID $jid.
+# This command automatically creates this submenu if needed.
+
+proc pep::get_roster_menu_pep_submenu {m connid jid} {
+    set pm $m.pep
+
+    if {![winfo exists $pm]} {
+	menu $pm -tearoff no
+	$m add cascade -menu $pm \
+		-label [::msgcat::mc "Personal eventing"]
+    }
+
+    return $pm
+}
+
+##########################################################################
+# Returns pathname of a frame comprising a page for PEP info in
+# the userinfo (vCard) dialog which notebook widget is $notebook.
+# If that page is not yet exist, it's created.
+
+proc pep::get_userinfo_dialog_pep_frame {notebook} {
+    if {[$notebook index PEP] < 0} {
+	return [$notebook insert end PEP \
+			-text [::msgcat::mc "Personal eventing"]]
+    } else {
+	return [$notebook getframe PEP]
+    }
+}
+
+proc pep::get_main_menu_pep_submenu {} {
+    return [.mainframe getmenu services].pep
+}
+
+proc pep::on_init {} {
+    set m [.mainframe getmenu services]
+    set idx [$m index [::msgcat::mc "Service Discovery"]]
+    set pm [menu $m.pep]
+    $m insert [expr {$idx + 2}] cascade -menu $pm \
+	    -label [::msgcat::mc "Personal Eventing"]
+}
+
+hook::add finload_hook [namespace current]::pep::on_init
+
+# vim:ts=8:sw=4:sts=4:noet


Property changes on: trunk/tkabber/pep.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native

Added: trunk/tkabber/plugins/pep/user_mood.tcl
===================================================================
--- trunk/tkabber/plugins/pep/user_mood.tcl	                        (rev 0)
+++ trunk/tkabber/plugins/pep/user_mood.tcl	2007-08-01 15:28:23 UTC (rev 1170)
@@ -0,0 +1,448 @@
+# $Id$
+# Implementation of XEP-0107 "User mood"
+# Based on Version 1.1 (2007-06-04).
+
+namespace eval mood {
+    variable node http://jabber.org/protocol/mood
+    variable substatus
+    variable mood
+
+    variable m2d
+    variable d2m
+
+    array set m2d [list \
+	afraid       [::msgcat::mc "afraid"] \
+	amazed       [::msgcat::mc "amazed"] \
+	angry        [::msgcat::mc "angry"] \
+	annoyed      [::msgcat::mc "annoyed"] \
+	anxious      [::msgcat::mc "anxious"] \
+	aroused      [::msgcat::mc "aroused"] \
+	ashamed      [::msgcat::mc "ashamed"] \
+	bored        [::msgcat::mc "bored"] \
+	brave        [::msgcat::mc "brave"] \
+	calm         [::msgcat::mc "calm"] \
+	cold         [::msgcat::mc "cold"] \
+	confused     [::msgcat::mc "confused"] \
+	contented    [::msgcat::mc "contented"] \
+	cranky       [::msgcat::mc "cranky"] \
+	curious      [::msgcat::mc "curious"] \
+	depressed    [::msgcat::mc "depressed"] \
+	disappointed [::msgcat::mc "disappointed"] \
+	disgusted    [::msgcat::mc "disgusted"] \
+	distracted   [::msgcat::mc "distracted"] \
+	embarrassed  [::msgcat::mc "embarrassed"] \
+	excited      [::msgcat::mc "excited"] \
+	flirtatious  [::msgcat::mc "flirtatious"] \
+	frustrated   [::msgcat::mc "frustrated"] \
+	grumpy       [::msgcat::mc "grumpy"] \
+	guilty       [::msgcat::mc "guilty"] \
+	happy        [::msgcat::mc "happy"] \
+	hot          [::msgcat::mc "hot"] \
+	humbled      [::msgcat::mc "humbled"] \
+	humiliated   [::msgcat::mc "humiliated"] \
+	hungry       [::msgcat::mc "hungry"] \
+	hurt         [::msgcat::mc "hurt"] \
+	impressed    [::msgcat::mc "impressed"] \
+	in_awe       [::msgcat::mc "in_awe"] \
+	in_love      [::msgcat::mc "in_love"] \
+	indignant    [::msgcat::mc "indignant"] \
+	interested   [::msgcat::mc "interested"] \
+	intoxicated  [::msgcat::mc "intoxicated"] \
+	invincible   [::msgcat::mc "invincible"] \
+	jealous      [::msgcat::mc "jealous"] \
+	lonely       [::msgcat::mc "lonely"] \
+	mean         [::msgcat::mc "mean"] \
+	moody        [::msgcat::mc "moody"] \
+	nervous      [::msgcat::mc "nervous"] \
+	neutral      [::msgcat::mc "neutral"] \
+	offended     [::msgcat::mc "offended"] \
+	playful      [::msgcat::mc "playful"] \
+	proud        [::msgcat::mc "proud"] \
+	relieved     [::msgcat::mc "relieved"] \
+	remorseful   [::msgcat::mc "remorseful"] \
+	restless     [::msgcat::mc "restless"] \
+	sad          [::msgcat::mc "sad"] \
+	sarcastic    [::msgcat::mc "sarcastic"] \
+	serious      [::msgcat::mc "serious"] \
+	shocked      [::msgcat::mc "shocked"] \
+	shy          [::msgcat::mc "shy"] \
+	sick         [::msgcat::mc "sick"] \
+	sleepy       [::msgcat::mc "sleepy"] \
+	stressed     [::msgcat::mc "stressed"] \
+	surprised    [::msgcat::mc "surprised"] \
+	thirsty      [::msgcat::mc "thirsty"] \
+	worried      [::msgcat::mc "worried"] \
+    ]
+    foreach m [array names m2d] {
+	set d2m($m2d($m)) $m
+    }
+    unset m
+
+    pubsub::register_event_notification_handler $node \
+	    [namespace current]::process_mood_notification
+    hook::add user_mood_notification_hook \
+	    [namespace current]::notify_via_status_message
+
+    hook::add finload_hook \
+	    [namespace current]::on_init 60
+    hook::add roster_jid_popup_menu_hook \
+	    [namespace current]::add_roster_pep_menu_item
+    hook::add roster_user_popup_info_hook \
+	    [namespace current]::provide_roster_popup_info
+    hook::add userinfo_hook \
+	    [namespace current]::provide_userinfo
+}
+
+proc mood::add_roster_pep_menu_item {m connid jid} {
+    set pm [pep::get_roster_menu_pep_submenu $m $connid $jid]
+
+    set mm [menu $pm.mood -tearoff no]
+    $pm add cascade -menu $mm \
+	    -label [::msgcat::mc "User mood"]
+
+    $mm add command \
+	    -label [::msgcat::mc "Subscribe"] \
+	    -command [list [namespace current]::subscribe $connid $jid]
+    $mm add command \
+	    -label [::msgcat::mc "Unsubscribe"] \
+	    -command [list [namespace current]::unsubscribe $connid $jid]
+
+    hook::run roster_pep_user_mood_menu_hook $mm $connid $jid
+}
+
+proc mood::subscribe {connid jid args} {
+    variable node
+    variable substatus
+
+    set to [node_and_server_from_jid $jid]
+    set cmd [linsert $args 0 [namespace current]::subscribe_result $to]
+    pep::subscribe $to $node \
+	    -connection $connid \
+	    -command $cmd
+    set substatus($to) sent-subscribe
+}
+
+proc mood::unsubscribe {connid jid args} {
+    variable node
+    variable substatus
+
+    set to [node_and_server_from_jid $jid]
+    set cmd [linsert $args 0 [namespace current]::unsubscribe_result $to]
+    pep::unsubscribe $to $node \
+	    -connection $connid \
+	    -command $cmd
+    set substatus($to) sent-unsubscribe
+}
+
+# Err may be one of: OK, ERR and DISCONNECT
+proc mood::subscribe_result {jid res child args} {
+    variable substatus
+
+    set cmd ""
+    foreach {opt val} $args {
+	switch  -- $opt {
+	    -command {
+		set cmd $val
+	    }
+	    default {
+		return -code error "unknown option: $opt"
+	    }
+	}
+    }
+
+    switch -- $res {
+	OK {
+	    set substatus($jid) from
+	}
+	ERR {
+	    set substatus($jid) error
+	}
+	default {
+	    return
+	}
+    }
+
+    if {$cmd != ""} {
+	lappend cmd $jid $res $child
+	eval $cmd
+    }
+}
+
+proc mood::unsubscribe_result {jid res child args} {
+    variable substatus
+    variable mood
+
+    set cmd ""
+    foreach {opt val} $args {
+	switch -- $opt {
+	    -command {
+		set cmd $val
+	    }
+	    default {
+		return -code error "unknown option: $opt"
+	    }
+	}
+    }
+    
+    if {[string equal $res OK]} {
+	set substatus($jid) none
+	array unset mood *,$jid
+    }
+
+    if {$cmd != ""} {
+	lappend cmd $jid $res $child
+	eval $cmd
+    }
+}
+
+proc mood::provide_roster_popup_info {var connid user} {
+    variable substatus
+    variable mood
+    variable m2d
+
+    upvar 0 $var info
+
+    set jid [node_and_server_from_jid $user]
+
+    if {[info exists mood(mood,$jid)]} {
+	set m $mood(mood,$jid)
+	if {[info exists m2d($m)]} {
+	    set status $m2d($m)
+	} else {
+	    set status $m
+	    debugmsg pubsub "Failed to found description for user mood \"$m\"\
+			     -- discrepancies with XEP-0107?"
+	}
+	if {[info exists mood(text,$jid)] && $mood(text,$jid) != ""} {
+	    append status ": " $mood(text,$jid)
+	}
+	append info [::msgcat::mc "\n\tMood: %s" $status]
+    } elseif {[info exists substatus($jid)]} {
+	append info [::msgcat::mc "\n\tUser's mood subscription: %s" \
+			    $substatus($jid)]
+    } else {
+	return
+    }
+
+}
+
+proc mood::process_mood_notification {connid jid items} {
+    variable node
+    variable substatus
+    variable mood
+
+    set newmood ""
+    set newtext ""
+    set parsed  false
+
+    foreach item $items {
+	jlib::wrapper:splitxml $item tag vars isempty chdata children
+
+	foreach imood $children {
+	    jlib::wrapper:splitxml $imood tag1 vars1 isempty1 chdata1 children1
+
+	    if {![string equal $tag1 mood]} continue
+	    set xmlns [jlib::wrapper:getattr $vars1 xmlns]
+	    if {![string equal $xmlns $node]} continue
+
+	    set parsed true
+
+	    foreach i $children1 {
+		jlib::wrapper:splitxml $i tag2 vars2 isempty2 chdata2 children2
+
+		switch -- $tag2 {
+		    text {
+			set newtext $chdata2
+		    }
+		    default {
+			set newmood $tag2
+		    }
+		}
+	    }
+	}
+    }
+
+    if {$parsed} {
+	set mood(mood,$jid) $newmood
+	set mood(text,$jid) $newtext
+
+	hook::run user_mood_notification_hook $connid $jid $newmood $newtext
+    }
+}
+
+proc mood::notify_via_status_message {connid jid mood text} {
+    variable m2d
+
+    set contact [::roster::itemconfig $connid $jid -name]
+    if {$contact == ""} {
+	set contact $jid
+    }
+
+    set msg [::msgcat::mc "%s's mood changed to %s" $contact $m2d($mood)]
+    if {$text != ""} {
+	append msg ": $text"
+    }
+
+    set_status $msg
+}
+
+proc mood::publish {connid mood args} {
+    variable node
+
+    set text ""
+    set callback ""
+    foreach {opt val} $args {
+	switch -- $opt {
+	    -reason  { set text $val }
+	    -command { set callback $val }
+	}
+    }
+
+    set content [list [jlib::wrapper:createtag $mood]]
+    if {$text != ""} {
+	lappend content [jlib::wrapper:createtag text -chdata $text]
+    }
+
+    set cmd [list pep::publish_item $node \
+	-connection $connid \
+	-payload [list [jlib::wrapper:createtag mood \
+				-vars [list xmlns $node] \
+				-subtags $content]]]
+
+    if {$cmd != ""} {
+	lappend cmd -command $callback
+    }
+
+    eval $cmd
+}
+
+proc mood::on_init {} {
+    set m [pep::get_main_menu_pep_submenu]
+    $m add command -label [::msgcat::mc "Publish user mood"] \
+	    -command [namespace current]::show_publish_dialog
+}   
+
+proc mood::show_publish_dialog {} {
+    variable d2m
+    variable moodvalue
+    variable moodreason
+    variable myjid
+
+    set connids [jlib::connections]
+    if {[llength $connids] == 0} {
+	tk_messageBox -icon error -title [::msgcat::mc "Error"] \
+		-message [::msgcat::mc "Publishing is only possible\
+					while being online"]
+	return
+    }
+
+    set w .user_mood
+    if {[winfo exists $w]} {
+	focus -force $w
+	return
+    }
+
+    Dialog $w -title [::msgcat::mc "User mood"] \
+	    -modal none -separator 1 -anchor e -default 0 -cancel 1 -parent .
+    $w add -text [::msgcat::mc "OK"] \
+	   -command [list [namespace current]::do_publish $w]
+    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
+
+    set f [$w getframe]
+
+    set connjids {}
+    foreach connid $connids {
+	lappend connjids [jlib::connection_jid $connid]
+    }
+    set myjid [lindex $connjids 0]
+
+    label $f.ccap -text [::msgcat::mc "Use connection:"]
+    ComboBox $f.conn -editable false \
+	    -values $connjids \
+	    -textvariable [namespace current]::myjid
+    label $f.mcap -text [::msgcat::mc "Mood:"]
+    ComboBox $f.mood -editable false \
+	    -values [lsort [array names d2m]] \
+	    -textvariable [namespace current]::moodvalue
+    label $f.rcap -text [::msgcat::mc "Reason:"]
+    entry $f.reason -textvariable [namespace current]::moodreason
+
+    if {[llength $connjids] > 1} {
+	grid $f.ccap   -row 0 -column 0 -sticky e
+	grid $f.conn   -row 0 -column 1 -sticky ew
+    }
+    grid $f.mcap   -row 1 -column 0 -sticky e
+    grid $f.mood   -row 1 -column 1 -sticky ew
+    grid $f.rcap   -row 2 -column 0 -sticky e
+    grid $f.reason -row 2 -column 1 -sticky ew
+
+    grid columnconfigure $f 1 -weight 1
+
+    $w draw
+}
+
+proc mood::do_publish w {
+    variable m2d
+    variable moodvalue
+    variable moodreason
+    variable myjid
+
+    if {$moodvalue == ""} {
+	tk_messageBox -icon error -title [::msgcat::mc "Error"] \
+		-message [::msgcat::mc "Cannot publish empty mood"]
+	return
+    }
+
+    foreach connid [jlib::connections] {
+	if {[string equal $myjid [jlib::connection_jid $connid]]} {
+	    publish $connid $m2d($moodvalue) \
+		    -reason $moodreason \
+		    -command [namespace current]::publish_result
+	    break
+	}
+    }
+
+    unset moodvalue moodreason myjid
+    destroy $w
+}
+
+# $res is one of: OK, ERR, DISCONNECT
+proc mood::publish_result {res child} {
+    switch -- $res {
+	ERR {
+	    set error [error_to_string $child]
+	}
+	default {
+	    return
+	}
+    }
+
+    tk_messageBox -icon error -title [::msgcat::mc "Error"] \
+	-message [::msgcat::mc "User mood publishing failed: %s" $error]
+}
+
+proc mood::provide_userinfo {notebook connid jid editable} {
+    variable mood
+    variable m2d
+    variable ::userinfo::userinfo
+
+    if {$editable} return
+
+    set barejid [node_and_server_from_jid $jid]
+    if {![info exists mood(mood,$barejid)]} return
+
+    set userinfo(mood,$jid) $m2d($mood(mood,$barejid))
+    if {[info exists mood(text,$barejid)]} {
+	set userinfo(moodreason,$jid) $mood(text,$barejid)
+    } else {
+	set userinfo(moodreason,$jid) ""
+    }
+
+    set f [pep::get_userinfo_dialog_pep_frame $notebook]
+    set mf [userinfo::pack_frame $f.mood [::msgcat::mc "User mood"]]
+
+    userinfo::pack_entry $jid $mf 0 mood [::msgcat::mc "Mood"]:
+    userinfo::pack_entry $jid $mf 1 moodreason [::msgcat::mc "Reason"]:
+}
+
+# vim:ts=8:sw=4:sts=4:noet


Property changes on: trunk/tkabber/plugins/pep/user_mood.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native

Modified: trunk/tkabber/pubsub.tcl
===================================================================
--- trunk/tkabber/pubsub.tcl	2007-07-31 17:15:30 UTC (rev 1169)
+++ trunk/tkabber/pubsub.tcl	2007-08-01 15:28:23 UTC (rev 1170)
@@ -43,7 +43,8 @@
 	subscription-notifications "http://jabber.org/protocol/pubsub#subscription-notifications" \
 	subscribe_authorization    "http://jabber.org/protocol/pubsub#subscribe_authorization" \
 	subscribe_options          "http://jabber.org/protocol/pubsub#subscribe_options" \
-	node_config                "http://jabber.org/protocol/pubsub#node_config"]
+	node_config                "http://jabber.org/protocol/pubsub#node_config" \
+	event                      "http://jabber.org/protocol/pubsub#event"]
 
     variable m2a
     variable a2m
@@ -298,7 +299,7 @@
     }
 
     set vars [list jid $jid]
-    if {$node == ""} {
+    if {$node != ""} {
 	lappend vars node $node
     }
 
@@ -1833,150 +1834,47 @@
 # Implemented in TODO
 
 ##########################################################################
-##########################################################################
 #
-# Personal eventing via pubsub XEP-0163
-#
+# Framework for handling of Pubsub event notifications.
 
-namespace eval pep {}
+proc pubsub::register_event_notification_handler {xmlns h} {
+    variable handler
+    variable supported_ns
 
-##########################################################################
-#
-# PEP Creating a node (5)
-# -connection is mandatory
-# -access_model (open, presence (default), roster, whitelist)
-# -roster_groups_allowed (roster group list if access is roster)
-#
-
-proc pep::create_node {node args} {
-    variable ns
-
-    debugmsg pep [info level 0]
-
-    set command ""
-    set access "presence"
-    set groups {}
-    foreach {key val} $args {
-	switch -- $key {
-	    -connection { set connid $val}
-	}
-    }
-
-    if {![info exists connid]} {
-	return -code error "pep::create_node: -connection is mandatory"
-    }
-
-    if {$node == ""} {
-	return -code error "pep::create_node: node must not be empty"
-    }
-
-    set service [jlib::connection_bare_jid $connid]
-
-    eval [list pubsub::create_node $service $node] $args
+    set handler($xmlns) $h
+    set supported_ns [array names handler]
 }
 
-##########################################################################
-#
-# Publish item to PEP node "node" (8)
-# payload is a list of xml tags
-# node must not be empty
-# -connection is mandatory
-#
+proc pubsub::process_event_notification {connid from mid type is_subject subject body \
+    err thread priority x} {
 
-proc pep::publish_item {node args} {
+    variable ::pubsub::ns
+    variable handler
 
-    debugmsg pep [info level 0]
+    set res ""
 
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -connection { set connid $val}
-	}
-    }
+    foreach event $x {
+	jlib::wrapper:splitxml $event tag vars isempty chdata children
+	if {![string equal $tag event]} continue
+	
+	set xmlns [jlib::wrapper:getattr $vars xmlns]
+	if {![string equal $xmlns $ns(event)]} continue
 
-    if {![info exists connid]} {
-	return -code error "pep::publish_item: -connection is mandatory"
-    }
+	foreach item $children {
+	    jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
+	    if {![string equal $tag1 items]} continue
 
-    if {$node == ""} {
-	return -code error "pep::publish_item: node must not be empty"
-    }
+	    set node [jlib::wrapper:getattr $vars1 node]
+	    if {![info exists handler($node)]} continue
 
-    set service [jlib::connection_bare_jid $connid]
-
-    eval [pubsub::publish_item $service $node ""] $args
-}
-
-##########################################################################
-#
-# Subscribe to PEP node "node" at bare JID "to" (5.2)
-# node must not be empty
-#
-# -jid "jid" is optional (when it's present it's included to sub request)
-#
-# -resource "res" is optional (when it's present bare_jid/res is included
-# to sub request
-#
-# if both options are absent then user's bare JID is included to sub
-# request
-#
-
-proc pep::subscribe {to node args} {
-
-    debugmsg pep [info level 0]
-
-    foreach {key val} $args {
-	switch -- $key {
-	    -connection { set connid $val}
+	    set res stop
+	    $handler($node) $connid $from $children1
 	}
     }
 
-    if {![info exists connid]} {
-	return -code error "pep::subscribe error: -connection is mandatory"
-    }
-
-    if {$node == ""} {
-	return -code error "pep::subscribe error: node must not be empty"
-    }
-
-    eval [list pubsub::subscribe $to $node] $args
+    return $res    
 }
 
-##########################################################################
-#
-# Unsubscribe from PEP node "node" at bare JID "to" (undocumented?!)
-# node must not be empty
-#
-# -jid "jid" is optional (when it's present it's included to sub request)
-#
-# -resource "res" is optional (when it's present bare_jid/res is included
-# to sub request
-#
-# if both options are absent then user's bare JID is included to sub
-# request
-#
+hook::add process_message_hook pubsub::process_event_notification
 
-proc pep::unsubscribe {to node args} {
-
-    debugmsg pep [info level 0]
-
-    set command ""
-    foreach {key val} $args {
-	switch -- $key {
-	    -connection { set connid $val}
-	}
-    }
-
-    if {![info exists connid]} {
-	return -code error "pep::unsubscribe error: -connection is mandatory"
-    }
-
-    if {$node == ""} {
-	return -code error "pep::unsubscribe error: node must not be empty"
-    }
-
-    eval [list pubsub::unsubscribe $to $node] $args
-}
-
-##########################################################################
-
+# vim:ts=8:sw=4:sts=4:noet

Modified: trunk/tkabber/tkabber.tcl
===================================================================
--- trunk/tkabber/tkabber.tcl	2007-07-31 17:15:30 UTC (rev 1169)
+++ trunk/tkabber/tkabber.tcl	2007-08-01 15:28:23 UTC (rev 1170)
@@ -251,6 +251,7 @@
 load_source privacy.tcl
 load_source gpgme.tcl
 load_source pubsub.tcl
+load_source pep.tcl
 load_source richtext.tcl
 
 load_source ifacetk bwidget_workarounds.tcl
@@ -260,6 +261,7 @@
 plugins::load [file join plugins roster]
 plugins::load [file join plugins search]
 plugins::load [file join plugins richtext]
+plugins::load [file join plugins pep]
 plugins::load [file join plugins $tcl_platform(platform)]
 if {[info exists env(TKABBER_SITE_PLUGINS)] && \
 	[file isdirectory $env(TKABBER_SITE_PLUGINS)]} {



More information about the Tkabber-dev mailing list