[Tcldrop/CVS] tcldrop/modules/irc irc.tcl

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/11/30 00:02:17

Modified files:
        modules/irc    : irc.tcl 

Log message:
        Redid the raw MODE bind proc..
        It's elegant now, and is smarter than Eggdrop's. =P

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/tcldrop/tcldrop/modules/irc/irc.tcl.diff?tr1=1.28&tr2=1.29&r1=text&r2=text

Patches:
Index: tcldrop/modules/irc/irc.tcl
diff -u tcldrop/modules/irc/irc.tcl:1.28 tcldrop/modules/irc/irc.tcl:1.29
--- tcldrop/modules/irc/irc.tcl:1.28    Sat Nov 29 17:24:25 2003
+++ tcldrop/modules/irc/irc.tcl Sun Nov 30 00:02:17 2003
@@ -4,7 +4,7 @@
 #              * All IRC related commands.
 #      Depends: core, server, channels.
 #
-# $Id: irc.tcl,v 1.28 2003/11/29 22:24:25 fireegl Exp $
+# $Id: irc.tcl,v 1.29 2003/11/30 05:02:17 fireegl Exp $
 #
 # Copyright (C) 2003 Tcldrop Development Team <Tcldrop-Devel>
 #
@@ -30,7 +30,7 @@
 namespace eval ::tcldrop::irc {
        # Provide the irc module:
        variable version {0.2}
-       variable rcsid {$Id: irc.tcl,v 1.28 2003/11/29 22:24:25 fireegl Exp $}
+       variable rcsid {$Id: irc.tcl,v 1.29 2003/11/30 05:02:17 fireegl Exp $}
        package provide tcldrop::irc $version
        # Initialize variables:
        # Nicks stores the non-channel specific info for each nick:
@@ -208,11 +208,9 @@
 bind time - {* * * * *} ::tcldrop::irc::JoinChannels
 proc ::tcldrop::irc::JoinChannels {args} {
        foreach channel [channels] {
-               if {[channel get $channel inactive]} {
-                       if {[botonchan $channel]} {
-                               putloglev d $channel "Joined +inactive channel 
$channel ...Leaving!"
-                               lappend partchannels $channel
-                       }
+               if {[channel get $channel inactive] && [botonchan $channel]} {
+                       putloglev d $channel "Joined +inactive channel $channel 
...Leaving!"
+                       lappend partchannels $channel
                } elseif {![botonchan $channel]} {
                        lappend joinchannels $channel
                } elseif {![botisop $channel]} {
@@ -224,59 +222,95 @@
        if {[info exists partchannels]} { puthelp "PART [join $partchannels ,]" 
}
 }
 
-# Proc by address@hidden
-# FixMe: Untested.
-# (Papillon) -> I do not know what you want to share with the pushmode, but 
here is a little something to get you started.
+# FixMe: Add support for server modes.
+# FixMe: Add support for personal modes. (maybe)
 bind raw - MODE ::tcldrop::irc::MODE 99
 proc ::tcldrop::irc::MODE {from key arg} {
-       # Note, it should share some code with the pushmode command I think..
+       putlog "MODE from: $from"
+       putlog "MODE key: $key"
+       putlog "MODE arg: $arg"
        set nick [lindex [set from [split $from !]] 0]
        set uhost [lindex $from 1]
-       set handle [finduser $uhost]
+       set handle [finduser $nick!$uhost]
        set channel [lindex [set arg [split $arg]] 0]
-       set modes [lindex $arg 1]
-       for {set a 0} {$a <= [string length $modes]} {incr a} {
-               set c [string index $modes $a]
-               if {$c != {:}} {
-                       append splitted "$c "
-               }
-       }
-       set v 2
-       variable ChannelNicks
-       foreach mo [split $splitted] {
-               if {$mo == {+} || $mo == {-}} {
-                       set lastm $mo
-               } elseif {$mo != {}} {
-                       set mc "${lastm}$mo"
-                       set victim [lindex $arg $v]
-                       set element [string tolower $channel,$victim]
-                       if {[info exists ChannelNicks($element)]} {
-                               array set nickinfo $ChannelNicks($element)
-                               switch  -- $mc {
-                                 {+o} { array set nickinfo [list op 1] }
-                                 {-o} { array set nickinfo [list op 0] }
-                                 {+v} { array set nickinfo [list voice 1] }
-                                 {-v} { array set nickinfo [list voice 0] }
-                                 {+h} { array set nickinfo [list halfop 1] }
-                                 {-h} { array set nickinfo [list halfop 0] }
+       set modes [string trimleft [lindex $arg 1] :]
+       set victims [lrange $arg 2 end]
+       putlog "MODE nick: $nick"
+       putlog "MODE uhost: $uhost"
+       putlog "MODE handle: $handle"
+       putlog "MODE channel: $channel"
+       putlog "MODE modes: $modes"
+       # First we process all the modes..
+       # For example, this takes a mode like:
+       # "+o-o FireEgl FireEgl"
+       # and appends it to the $splitmodes list as:
+       # {-o FireEgl}
+       # (Note the missing +o FireEgl ..since it doesn't actually do anything 
in the real world it got removed.)
+       set v -1
+       lappend splitmodes
+       foreach m [split $modes {}] {
+               switch -- $m {
+                       {+} - {-} { set plusminus $m }
+                       {} {}
+                       {default} {
+                               # This searches $splitmodes to see if there's 
already a similar mode already saved:
+                               if {[set pos [lsearch $splitmodes ?[set mode 
"$m [lindex $victims [incr v]]"]]] != -1} {
+                                       # A similar mode was found, replace it:
+                                       set splitmodes [lreplace $splitmodes 
$pos $pos $plusminus$mode]
+                               } else {
+                                       # No similar mode was found, append to 
the list:
+                                       lappend splitmodes $plusminus$mode
                                }
-                               set ChannelNicks($element) [array get nickinfo]
                        }
-                       incr v
-                       foreach b [binds mode] {
-                               foreach {type flags mask count proc} $b {}
-                               if {[string match -nocase $mask "$channel 
$mc"]} {
-                                       ::tcldrop::countbind $type $mask $proc
-                                       if {[catch { $proc $nick $uhost $handle 
$channel $mc $victim} err]} {
-                                               putlog "Error in $proc: $err"
-                                               puterrlog "$::errorInfo"
-                                       }
+               }
+       }
+       foreach m $splitmodes {
+               set mode [string range $m 0 1]
+               set victim [string range $m 3 end]
+               # This switch discards all the modes that don't make any 
changes on $channel:
+               # (Such as a +o on somebody that already had ops)
+               switch -- $mode {
+                       {+o} { if {[isop $victim $channel]} { continue } }
+                       {-o} { if {![isop $victim $channel]} { continue } }
+                       {+v} { if {[isvoice $victim $channel]} { continue } }
+                       {-v} { if {![isvoice $victim $channel]} { continue } }
+                       {+h} { if {[ishalfop $victim $channel]} { continue } }
+                       {-h} { if {![ishalfop $victim $channel]} { continue } }
+               }
+               # If a "continue" wasn't triggered above,
+               # we call all of the mode binds with that mode:
+               foreach b [binds mode] {
+                       foreach {type flags mask count proc} $b {}
+                       if {[string match -nocase $mask "$channel $mode"]} {
+                               if {[catch { $proc $nick $uhost $handle 
$channel $mode $victim } err]} {
+                                       putlog "Error in $proc: $err"
+                                       puterrlog "$::errorInfo"
                                }
+                               ::tcldrop::countbind $type $mask $proc
                        }
                }
        }
 }
 
+bind mode - "* ?o" ::tcldrop::irc::mode 0
+bind mode - "* ?v" ::tcldrop::irc::mode 0
+bind mode - "* ?h" ::tcldrop::irc::mode 0
+proc ::tcldrop::irc::mode {nick uhost handle channel mode victim} {
+       variable ChannelNicks
+       if {[info exists ChannelNicks([set element [string tolower 
"$channel,$victim"]])]} {
+               array set channickinfo $ChannelNicks($element)
+       }
+       switch -- $mode {
+         {+o} { array set channickinfo [list op 1] }
+         {-o} { array set channickinfo [list op 0] }
+         {+v} { array set channickinfo [list voice 1] }
+         {-v} { array set channickinfo [list voice 0] }
+         {+h} { array set channickinfo [list halfop 1] }
+         {-h} { array set channickinfo [list halfop 0] }
+       }
+       set ChannelNicks($element) [array get channickinfo]
+}
+
 
 # irc.choopa.net: 311 FireEgl FireEgl ~FireEgl 
adsl-17-134-83.bhm.bellsouth.net * Proteus
 # Process results from a WHOIS:
@@ -339,7 +373,6 @@
        set ident [lindex [split $from address@hidden 1]
        set address [lindex [split $from @] end]
        set handle [finduser $from]
-       #Updating the Nicks/ChannelNicks arrays
        variable ChannelNicks
        array set channickinfo [list nick $nick op 0 voice 0 halfop 0]
        set ChannelNicks([string tolower "$channel,$nick"]) [array get 
channickinfo]
@@ -347,7 +380,7 @@
        if {[info exists Nicks([set element [string tolower $nick]])]} { array 
set nickinfo $Nicks($element) }
        array set nickinfo [list nick $nick handle $handle ident $ident address 
$address]
        set Nicks($element) [array get nickinfo]
-       # Call all the join binds:
+       # Call all of the join binds:
        foreach b [binds join] {
                foreach {type flags mask count proc} $b {}
                if {[string match -nocase $mask "$channel $from"] && [matchattr 
$handle $flags $channel]} {
@@ -644,10 +677,8 @@
        }
        variable ChannelNicks
        array unset ChannelNicks [string tolower "$channel,$nick"]
-       if {![onchan $nick]} {
-               variable Nicks
-               array unset Nicks [string tolower $nick]
-       }
+       variable Nicks
+       array unset Nicks [string tolower $nick]
 }
 
 # Process the results from NOTICE $channel:
@@ -742,7 +773,7 @@
 #    Module: irc
 proc ::tcldrop::irc::ischanban {ban channel} {
        variable Bans
-       info exists Bans([string tolower $channel,$ban])
+       info exists Bans([string tolower "$channel,$ban"])
 }
 
 #  ischanexempt <exempt> <channel>
@@ -751,7 +782,7 @@
 #    Module: irc
 proc ::tcldrop::irc::ischanexempt {exempt channel} {
        variable Exempts
-       info exists Exempts([string tolower $channel,$exempt])
+       info exists Exempts([string tolower "$channel,$exempt"])
 }
 
 #  ischaninvite <invite> <channel>
@@ -768,10 +799,10 @@
 #      a sublist of the form {<ban> <bywho> <age>}. age is seconds from the
 #      bot's POV.
 #    Module: irc
-proc ::tcldrop::irc::chanbans {channel} {
+proc ::tcldrop::irc::chanbans {channel {banmask {*}}} {
        set banlist [list]
        variable Bans
-       foreach b [array names Bans [string tolower $channel],*] {
+       foreach b [array names Bans [string tolower $channel],$banmask] {
                array set baninfo $Bans($b)
                lappend banlist [list $baninfo(ban) $baninfo(creator) 
$baninfo(created)]
        }
@@ -784,10 +815,10 @@
 #      bot's POV.
 #    Module: irc
 # FixMe: Add support for the age.
-proc ::tcldrop::irc::chanexempts {channel} {
+proc ::tcldrop::irc::chanexempts {channel {exemptmask {*}}} {
        set exemptlist [list]
        variable Exempts
-       foreach b [array names Exempts [string tolower $channel],*] {
+       foreach b [array names Exempts [string tolower $channel],$exemptmask] {
                array set exemptinfo $Exempts($b)
                lappend exemptlist [list $exemptinfo(exempt) 
$exemptinfo(creator) $exemptinfo(created)]
        }
@@ -799,10 +830,10 @@
 #      a sublist of the form {<invite> <bywho> <age>}. age is seconds from the
 #      bot's POV.
 #    Module: irc
-proc ::tcldrop::irc::chaninvites {channel} {
+proc ::tcldrop::irc::chaninvites {channel {invitemask {*}}} {
        set invitelist [list]
        variable Invites
-       foreach b [array names Invites [string tolower $channel],*] {
+       foreach b [array names Invites [string tolower $channel],$invitemask] {
                array set inviteinfo $Invites($b)
                lappend invitelist [list $inviteinfo(ban) $inviteinfo(creator) 
$inviteinfo(created)]
        }
@@ -848,7 +879,7 @@
 #      any channel if none is specified); 0 otherwise
 proc ::tcldrop::irc::onchan {nick {channel {*}}} {
        variable ChannelNicks
-       if {[array names ChannelNicks [string tolower $channel,$nick]] != {}} {
+       if {[array names ChannelNicks [string tolower "$channel,$nick"]] != {}} 
{
                return 1
        } else {
                return 0
@@ -865,9 +896,7 @@
 #      specified, the bot will check all of its channels. If the nick is
 #      not found, "" is returned. If the nick is found but does not have
 #      a handle, "*" is returned.
-#
-#      channel is ignored, since Tcldrop stores this particular info in a
-#      central place.
+# Note: Like Eggdrop, Tcldrop ignores $channel.
 proc ::tcldrop::irc::nick2hand {nick {channel {*}}} {
        variable Nicks
        if {[info exists Nicks([set element [string tolower $nick]])]} {
@@ -1009,7 +1038,7 @@
                set channel [string tolower $channel]
                if {[info exists PushModes($channel)] && [set pos [lsearch 
-glob $PushModes($channel) "?[string index $mode 1] $arg"]] != -1} {
                        # A conflicting or duplicate mode was found. So we 
replace it.
-                       lreplace $PushModes($channel) $pos $pos "$mode $arg"
+                       set PushModes [lreplace $PushModes($channel) $pos $pos 
"$mode $arg"]
                } else {
                        # Otherwise we just lappend to the end:
                        lappend PushModes($channel) "$mode $arg"