[Tkabber-dev] r180 - trunk/plugins/bldjid

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Mar 28 09:13:20 MSK 2009


Author: bigote
Date: 2009-03-28 09:13:19 +0300 (Sat, 28 Mar 2009)
New Revision: 180

Modified:
   trunk/plugins/bldjid/ChangeLog
   trunk/plugins/bldjid/bldjid.tcl
Log:
No need to patch muc.tcl now: thanks to Alexey Smirnov for his procedure
and to Ruslan Rakhmanin for his help in adapting it for 8.4 version of Tcl.

Added Customize options "enabled", "verbosity_level" (only Minimum at the moment),
"send_chat_messages". There will be more ;)


Modified: trunk/plugins/bldjid/ChangeLog
===================================================================
--- trunk/plugins/bldjid/ChangeLog	2009-03-23 02:15:35 UTC (rev 179)
+++ trunk/plugins/bldjid/ChangeLog	2009-03-28 06:13:19 UTC (rev 180)
@@ -1,3 +1,20 @@
+2009-03-28  Serge Yudin  <xmpp:bigote at jabber.ru> <mailto:bigote at gmail.com>
+
+--- Version 0.4a2 of the plugin.
+--- Files modified:
+    bldjid.tcl, ChangeLog.
+
+--- Changes:
+	The procedure that was added to avoid muc.tcl patching works already.
+	Some Customize options added. There will be more ;)
+
+--- TODO:
+	Heavy testing and feedback needed.
+	Uncomment Customize options and make them work correctly.
+	Optimize the code.
+
+	In the future, antiflood is planned to be implemented.
+
 2009-03-23  Serge Yudin  <xmpp:bigote at jabber.ru> <mailto:bigote at gmail.com>
 
 ---	Version 0.4a1 of the plugin.

Modified: trunk/plugins/bldjid/bldjid.tcl
===================================================================
--- trunk/plugins/bldjid/bldjid.tcl	2009-03-23 02:15:35 UTC (rev 179)
+++ trunk/plugins/bldjid/bldjid.tcl	2009-03-28 06:13:19 UTC (rev 180)
@@ -1,12 +1,11 @@
-# "Bldjid" plugin for Tkabber. 2009-03-23 v. 0.4a1
+# "Bldjid" plugin for Tkabber. 2009-03-28 v. 0.4a2
 # Written by Serge Yudin xmpp:bigote at jabber.ru
 # See README file for usage.
 
 
 namespace eval bldjid {
-	variable hid_grp_msg
-	variable list_to_show
-	variable jids_by_chats [dict create]
+	variable jids
+	variable jids_by_chats
 
 	set winid 0
     ::msgcat::mcload [file join [file dirname [info script]] msgs]
@@ -15,54 +14,110 @@
         [namespace current]::command_comps
     hook::add chat_send_message_hook \
         [namespace current]::handle_commands 17
+
+# Set plugin options.
+    set verbosity [list \
+                    min [::msgcat::mc "Minimum:\
+                    Log each entrance of a user\
+                    only once per room (less memory used)."]]
+#					max [::msgcat::mc "Maximum: Also log timestamps\
+#                    (all entrances of each user will be logged)."]]
+
+    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
+
+    custom::defgroup Bldjid [::msgcat::mc "Bldjid options."] -group Plugins
+
+    custom::defvar options(enabled) 1 \
+        [::msgcat::mc "Enable JIDs logging (only works if\
+        ::muc::options(gen_enter_exit_msgs) is disabled)."] \
+        -type boolean -group Bldjid
+
+#    custom::defvar options(filter_admin_rooms) 1 \
+#        [::msgcat::mc "Only will log JIDs in the rooms where you have\
+#        admin privileges."] \
+#        -type boolean -group Bldjid
+
+    custom::defvar options(verbosity_level) min \
+        [::msgcat::mc "Verbosity level."] \
+        -type radio -group Bldjid -layout vertical -values $verbosity
+
+        custom::defvar options(send_chat_messages) 0 \
+            [::msgcat::mc "Generate and send to chats smart system messages\
+            about user entrances (will only work with Minimum verbosity level)."] \
+            -type boolean -group Bldjid
+
+#    custom::defvar options(log_length) 3000 \
+#        [::msgcat::mc "Max length of your JID list. Empty field means unlimited."] \
+#        -type integer -group Bldjid
+
 }
 
-## REQUIRED TCL/TK 8.5 and above ##
-## Thanks to sceptic <alexey.smirnov at gmx.com>
+## Thanks to Alexey Smirnov <alexey.smirnov at gmx.com>
+## and Rakhmanin Ruslan <rakhmaninr at gmail.com>
 ## Adapted to bldjid's necessities by Serge Yudin
 proc bldjid::smart_enter_exit_message {xlib jid type x args} {
-    variable jids_by_chats
-
+	variable options
+	if {!($options(enabled) && !$::muc::options(gen_enter_exit_msgs))} {
+		return stop
+	}
     if {$type != "available"} {
-        return
+        return stop
     }
+    set group [::xmpp::jid::stripResource $jid]
+# TODO: Add check if the current group is valid 
+# in case options(filter_admin_rooms) is enabled
+#	set v_groups [[namespace current]::valid_groups $xlib]
+#puts $v_groups
+#	if {$options(filter_admin_rooms)} {
+#puts [lsearch -exact $v_groups $group]
+#		if {[lsearch -exact $v_groups $group] < 0} {
+#			return stop
+#		}
+#	}
 
-    set group [::xmpp::jid::stripResource $jid]
+#	set iam [lindex [whoami $xlib $group] 1]
+#	if {$iam == "" || !($iam == "admin" || $iam == "owner")} {
+#		return
+#	}
     set chatid [::chat::chatid $xlib $group]
-
     if {[::chat::is_opened $chatid]} {
-
         if {[::chat::is_groupchat $chatid]} {
-                                                                                                        
             if {[::xmpp::jid::resource $jid] == ""} {
-                return
+                return stop
             }
-
             set nick [::chat::get_nick $xlib $jid groupchat]
-            set real_jid [::muc::get_real_jid $xlib $group/$nick]
+			set ts ""
+			if {$options(verbosity_level) != "min"} {
+				set ts [clock format [clock seconds] \
+				-format $::plugins::options(timestamp_format)]
+			}
+			set real_jid [::xmpp::jid::stripResource \
+				[::muc::get_real_jid $xlib $group/$nick]]
+#            if {$real_jid == ""} {
+#                return
+#            }
+			variable jids_by_chats
 
-            if {$real_jid == ""} {
-                return
-            }
-
-            if {[dict exists $jids_by_chats $group]} {
-                set jids [dict get $jids_by_chats $group]
-
-                if {[lsearch -exact $jids $real_jid] >= 0} {
-                    return
-                }
-            }
-
-            dict lappend jids_by_chats $group $real_jid
-
-            set occupant "$nick ($real_jid)"
-            set msg [::msgcat::mc "%s has entered" $occupant]
-
-            ::chat::add_message $chatid $group groupchat $msg {}
-        }
+           	if {[info exists jids_by_chats($group)]} {
+               	set jids $jids_by_chats($group)
+				foreach item $jids {
+					if {$options(verbosity_level) == "min"} {
+	                	if {[lsearch -exact [lindex $item 2] $real_jid] >= 0} {
+    	                	return stop
+        	        	}
+					}
+				}
+           	}
+           	lappend jids_by_chats($group) [list $ts $nick $real_jid]
+			if {$options(send_chat_messages) && $options(verbosity_level) == "min"} {
+            	set occupant "$nick ($real_jid)"
+   	        	set msg [::msgcat::mc "%s has entered" $occupant]
+       	    	::chat::add_message $chatid $group groupchat $msg {}
+			}
+		}
     }
 }
-#hook::add client_presence_hook \
+hook::add client_presence_hook \
     [namespace current]::bldjid::smart_enter_exit_message 98
 
 proc bldjid::command_comps {chatid compsvar wordstart line} {
@@ -97,19 +152,7 @@
     if {$type != "groupchat"} return
 
     set xlib [chat::get_xlib $chatid]
-    set groupjids {}
-	# Filter out wrong conferences. 
-	# We assume IRC-channels have to have "irc" part in their transport name.
-	# If some transport doesn't have it (1% of probability), 
-	# a ban request will be sent there and we'll get an error.
-    foreach tmpchatid [lsort [lfilter chat::is_groupchat [chat::opened $xlib]]] {
-		set tmpgrp [chat::get_jid $tmpchatid]
-		if {([lindex [whoami $xlib $tmpgrp] 1] == "admin" \
-		||   [lindex [whoami $xlib $tmpgrp] 1] == "owner") \
-		&&  ![string match *%*@irc* $tmpgrp]} {
-			 lappend groupjids $tmpgrp
-		}
-	}
+    set groupjids [[namespace current]::valid_groups $xlib]
    	set room ""
    	set nick ""
    	if {[string equal [string range $body 0 9] "/unbldjid "]} {
@@ -135,21 +178,21 @@
 		set index [muc::parse_nick $body 8]
 	} elseif {[string equal [string range $body 0 7] "/bldhelp"]} {
 	} else {
-    	return
+    	return stop
     }
 	
 	switch -- $cmd {
 		/unbldjid {
-	    foreach group $groupjids {
-           	muc::unban $xlib $group $jid
+		    foreach group $groupjids {
+    	       	muc::unban $xlib $group $jid
+			}
 		}
-		}
 
 		/bldjid {
-	    foreach group $groupjids {
-			[namespace current]::send_ban_request $xlib $group $params $jid $reason
+		    foreach group $groupjids {
+				[namespace current]::send_ban_request $xlib $group $params $jid $reason
+			}
 		}
-		}
 
 		/banjid {
 			set group [chat::get_jid $chatid]
@@ -157,146 +200,213 @@
 		}
 		
 		/amnesty {
-		set group [chat::get_jid $chatid]
-    	variable winid
-	    set w .amn$winid
-    	incr winid
-	    if {[winfo exists $w]} {
-    	    destroy $w
-	    }
-	    Dialog $w -title [::msgcat::mc "Forgive all outcasts here?"]] \
-    	    -modal none -separator 1 -anchor e -default 0 -cancel 1 \
-        	-parent .
-	    set f [$w getframe]
-    	$w add -text [::msgcat::mc "OK"] \
-        	-command [list [namespace current]::amnesty $chatid $attr $val $w $f]
-	    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
+			set group [chat::get_jid $chatid]
+	    	variable winid
+		    set w .amn$winid
+    		incr winid
+		    if {[winfo exists $w]} {
+    		    destroy $w
+	    	}
+		    Dialog $w -title [::msgcat::mc "Forgive all outcasts here?"]] \
+    		    -modal none -separator 1 -anchor e -default 0 -cancel 1 \
+        		-parent .
+		    set f [$w getframe]
+    		$w add -text [::msgcat::mc "OK"] \
+        		-command [list [namespace current]::amnesty $chatid $attr $val $w $f]
+		    $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
 
-		label $w.lsure -padx 10 -pady 5 \
-		-text "Are you sure you want to unban all outcasts in this room?\n\
-		   There will be no backup: you're either kind-hearted or not ;)"
-		pack $w.lsure -expand yes -fill both
-		$w draw
+			label $w.lsure -padx 10 -pady 5 \
+			-text "Are you sure you want to unban all outcasts in this room?\n\
+			   There will be no backup: you're either kind-hearted or not ;)"
+			pack $w.lsure -expand yes -fill both
+			$w draw
 		}
 		
 		/visitors {
-		variable hid_grp_msg
-		variable list_to_show
-		set group [chat::get_jid $chatid]
-		set list_to_show {}
-		if {$room == ""} {
-			set room $group
-			set header "Show all visits to the current room:"
-		} else {
-			set header "Show all visits to rooms that match *$room*:"
-		}
-		foreach item $muc::hid_grp_msg {
-			if {[string match *$room* [lindex $item 0]]} {
-				lappend list_to_show $item
+			variable jids
+			variable jids_by_chats
+			set group [chat::get_jid $chatid]
+			set jids {}
+			if {$room == ""} {
+				set room $group
+				set header "Show all visits to the current room:"
+			} else {
+				set header "Show all visits to room $room:"
 			}
+
+			if {[info exists jids_by_chats($room)]} {
+				set jids $jids_by_chats($room) 
+			} else {
+				chat::add_message $chatid $group error \
+				"Room '$room' doesn't exist. Make sure you provide a full room's JID." {}
+				return stop
+			}
+	        set n 0
+			chat::add_message $chatid $group error $header {}
+			foreach msg $jids {
+   				chat::add_message $chatid $group info "$n: [join $msg]" {}
+				incr n
+			}
 		}
-        set n 0
-		chat::add_message $chatid $group error $header {}
-		foreach msg $list_to_show {
-        	chat::add_message $chatid $group info "$n: [join $msg]" {}
-			incr n
-		}
-		}
 
         /visited {
-        variable hid_grp_msg
-        variable list_to_show
-        set group [chat::get_jid $chatid]
-        set list_to_show {}
-        if {$nick == ""} {
-            set header "*Show all visits to all rooms*:"
-        } elseif {$room == ""} {
-			set header "Show visits of *$nick* to all rooms:"
-        } else {
-            set header "Show visits of *$nick* to rooms that match *$room*:"
+	        variable jids_by_chats
+    	    variable jids
+        	set group [chat::get_jid $chatid]
+	        set jids {}
+
+			if {$nick == ""} {
+				set header "Show all visits to all rooms:"
+set jids "Not implemented yet."
+# TODO: add this stuff.
+			} elseif {$room == ""} {
+				set header "Show visits of $nick to all rooms:"
+				set groupjids [[namespace current]::valid_groups $xlib]
+				foreach grp $groupjids {
+					if {[info exists jids_by_chats($grp)]} {
+                    	foreach item $jids_by_chats($grp) {
+							if {[string equal [lindex $item 1] $nick]} {
+								lappend item $grp
+    	                    	lappend jids $item
+							}
+						}
+       	            }
+				}
+			} else {
+				set header "Show visits of $nick to room $room:"
+	            if {[info exists jids_by_chats($room)]} {
+					foreach item $jids_by_chats($room) {
+						if {[string equal [lindex $item 1] $nick]} {
+       		        		lappend jids $item
+						}
+					}
+	            } else {
+       		        chat::add_message $chatid $group error \
+               		"Room '$room' doesn't exist. \
+					Make sure you provide a full room's JID." {}
+       		        return stop
+	            }
+			}
+			set n 0
+			chat::add_message $chatid $group error $header {}
+    	    foreach msg $jids {
+        	    chat::add_message $chatid $group info "$n: [join $msg]" {}
+				incr n
+	        }
         }
-        foreach item $muc::hid_grp_msg {
-            if {[string match *$room* [lindex $item 0]] \
-             && [string match *$nick* [lindex $item 2]]} {
-                lappend list_to_show $item
-            }
-        }
-		set n 0
-		chat::add_message $chatid $group error $header {}
-        foreach msg $list_to_show {
-            chat::add_message $chatid $group info "$n: [join $msg]" {}
-			incr n
-        }
-        }
 
 		/pickup {
-        variable list_to_show
-        set group [chat::get_jid $chatid]
-	    set maxindex [expr {[llength $list_to_show] - 1}]
-	    if {$maxindex < 0} {
-       		# Nothing to show: list is empty.
-	        chat::add_message $chatid $group error "The list is empty." {}
-	        return stop
-	    } elseif {$index > $maxindex || $index < 0} {
-			chat::add_message $chatid $group error "Index out of range." {}
-			return stop
-		} elseif {![string is integer $index]} {
-			chat::add_message $chatid $group error "Index must be integer." {}
-			return stop
-		} else {
-			chat::add_message $chatid $group error "TODO: JID from the chosen message has to be put into the editor field.\
-			\nThe cursor should go to the beginning of the line.\
-			\nAt the moment you have the chosen message here:\
-			\n[lindex $list_to_show $index]" {}
+	        variable jids
+    	    set group [chat::get_jid $chatid]
+	    	set maxindex [expr {[llength $jids] - 1}]
+		    if {$maxindex < 0} {
+    	   		# Nothing to show: list is empty.
+	    	    chat::add_message $chatid $group error "The list is empty." {}
+	        	return stop
+		    } elseif {$index > $maxindex || $index < 0} {
+				chat::add_message $chatid $group error "Index out of range." {}
+				return stop
+			} elseif {![string is integer $index]} {
+				chat::add_message $chatid $group error "Index must be integer." {}
+				return stop
+			} else {
+				set jid [lindex [lindex $jids $index] 2]
+puts $jid
+puts $chatid
+				if {$jid != ""} {
+					set ci [chat::input_win $chatid]
+puts $ci
+# Strange, but it doesn't work.
+# (it should insert JID into the current input window):
+					$ci insert insert $jid
+# So at the moment let's just ban it (with confirmation, however).
+# One more strange thing: now it can be seen that the previous command
+# DOES INSERT the jid AFTER "/pickup n" but when the confirmation window appears
+# the input window gets cleared.
+            variable winid
+            set w .pickup$winid
+            incr winid
+
+			set params {affiliation outcast}
+			Dialog $w -title [::msgcat::mc "Ban this JID here?"]] \
+                -modal none -separator 1 -anchor e -default 0 -cancel 1 \
+                -parent .
+            set f [$w getframe]
+            $w add -text [::msgcat::mc "OK"] \
+                -command [list [namespace current]::confirm_ban \
+				$xlib $group $params $jid {} $w]
+            $w add -text [::msgcat::mc "Cancel"] -command [list destroy $w]
+
+            label $w.lsure -padx 10 -pady 5 \
+            -text "Are you sure you want to ban $jid in the current room ($group)?"
+            pack $w.lsure -expand yes -fill both
+            $w draw	
+				}
+			}
 		}
-		}
 
 		/bldhelp {
-		set group [chat::get_jid $chatid]
-		chat::add_message $chatid $group error "Short usage examples for Bldjid plugin" {}
-		chat::add_message $chatid $group info "Ban in all rooms where you have admin privileges:\
+			set group [chat::get_jid $chatid]
+			chat::add_message $chatid $group error \
+			"Short usage examples for Bldjid plugin" {}
+			chat::add_message $chatid $group info \
+			"Ban in all rooms where you have admin privileges:\
 			\n/bldjid JID\
 			\nSome reason for banning (optional)." {}
-		chat::add_message $chatid $group info "Unban a banned person in these rooms:\
+			chat::add_message $chatid $group info \
+			"Unban a banned person in these rooms:\
 			\n/unbldjid JID" {}
-		chat::add_message $chatid $group info "Ban a user in the current room by his/her JID:\
+			chat::add_message $chatid $group info \
+			"Ban a user in the current room by his/her JID:\
 			\n/banjid JID\
 			\nSome reason for banning (optional)." {}
-		chat::add_message $chatid $group info "Unban all people banned in the current room:\
+			chat::add_message $chatid $group info \
+			"Unban all people banned in the current room:\
 			\n/amnesty" {}
-		chat::add_message $chatid $group info "Show all visitors of the current room:\
+			chat::add_message $chatid $group info \
+			"Show all visitors of the current room:\
 			\n/visitors" {}
-		chat::add_message $chatid $group info "Show all visitors of rooms that match *room*:\
+			chat::add_message $chatid $group info \
+			"Show all visitors of rooms that match *room*:\
 			\n/visitors room" {}
-		chat::add_message $chatid $group info "Show all visits to all rooms:\
+			chat::add_message $chatid $group info \
+			"Show all visits to all rooms:\
 			\n/visited" {}
-		chat::add_message $chatid $group info "Show visits made by someone whose nick or JID matches *nick*:\
+			chat::add_message $chatid $group info \
+			"Show visits made by someone whose nick or JID matches *nick*:\
 			\n/visited nick" {}
-		chat::add_message $chatid $group info "Shows visits made by *nick*, to the rooms that match *room*:\
+			chat::add_message $chatid $group info \
+			"Shows visits made by *nick*, to the rooms that match *room*:\
 			\n/visited nick\
 			\nroom" {}
-		chat::add_message $chatid $group info "Choose a JID from the list given by /visit* commands:\
+			chat::add_message $chatid $group info \
+			"Choose a JID from the list given by /visit* commands:\
 			\n/pickup ?n?" {}
 		}
 	}
     return stop
 }
 
+proc bldjid::confirm_ban {xlib group params jid reason w} {
+	destroy $w
+	[namespace current]::send_ban_request $xlib $group $params $jid $reason
+}
+
 proc bldjid::send_ban_request {xlib group params jid reason} {
-		    set itemsubtags {}
-		    if {$reason != ""} {
-		        lappend itemsubtags [::xmpp::xml::create reason -cdata $reason]
-		    }
-		    set vars [list jid $jid]
-		    set item [::xmpp::xml::create item \
-                  -attrs [concat $vars $params] \
-                  -subelements $itemsubtags]
-		    ::xmpp::sendIQ $xlib set \
-        		-query [::xmpp::xml::create query \
-                -xmlns $::NS(muc#admin) \
-                -subelement $item] \
-		        -to $group \
-        		-command [list [namespace current]::test_error_res "$params \'$jid\'" $xlib $group]
+	set itemsubtags {}
+	if {$reason != ""} {
+	    lappend itemsubtags [::xmpp::xml::create reason -cdata $reason]
+	}
+	set vars [list jid $jid]
+	set item [::xmpp::xml::create item \
+        -attrs [concat $vars $params] \
+        -subelements $itemsubtags]
+	::xmpp::sendIQ $xlib set \
+    	-query [::xmpp::xml::create query \
+        -xmlns $::NS(muc#admin) \
+        -subelement $item] \
+	    -to $group \
+    	-command [list [namespace current]::test_error_res "$params \'$jid\'" $xlib $group]
 }
 
 proc bldjid::test_error_res {op xlib group res child} {
@@ -392,5 +502,20 @@
 	}
 }
 
+proc bldjid::valid_groups {xlib} {
+	# Filter out wrong conferences. 
+	# We assume IRC-channels have to have "irc" part in their transport name.
+	# If some transport doesn't have it (1% of probability), 
+	# a ban request will be sent there and we'll get an error.
+	set grpjids ""
+    foreach tmpchatid [lsort [lfilter chat::is_groupchat [chat::opened $xlib]]] {
+		set tmpgrp [chat::get_jid $tmpchatid]
+		set iam [lindex [whoami $xlib $tmpgrp] 1]
+		if {($iam == "admin" || $iam == "owner") \
+		&&  ![string match *%*@irc* $tmpgrp]} {
+			 lappend grpjids $tmpgrp
+		}
+	}
+	return $grpjids
+}
 
-



More information about the Tkabber-dev mailing list