[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Tcldrop/CVS] tcldrop/modules/irc irc.tcl
From: |
Philip Moore |
Subject: |
[Tcldrop/CVS] tcldrop/modules/irc irc.tcl |
Date: |
Sun, 30 Nov 2003 00:02:17 -0500 |
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"