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

[Philip Moore]

CVSROOT:        /cvsroot/tcldrop
Module name:    tcldrop
Branch:         
Changes by:     Philip Moore <address@hidden>   03/11/29 01:05:56

Modified files:
        modules/irc    : irc.tcl 

Log message:
        Overhauled most of the irc-related commands Papillion made.. (Untested)

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

Patches:
Index: tcldrop/modules/irc/irc.tcl
diff -u tcldrop/modules/irc/irc.tcl:1.26 tcldrop/modules/irc/irc.tcl:1.27
--- tcldrop/modules/irc/irc.tcl:1.26    Sat Nov 29 00:04:29 2003
+++ tcldrop/modules/irc/irc.tcl Sat Nov 29 01:05:56 2003
@@ -4,7 +4,7 @@
 #              * All IRC related commands.
 #      Depends: core, server, channels.
 #
-# $Id: irc.tcl,v 1.26 2003/11/29 05:04:29 fireegl Exp $
+# $Id: irc.tcl,v 1.27 2003/11/29 06:05:56 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.26 2003/11/29 05:04:29 fireegl Exp $}
+       variable rcsid {$Id: irc.tcl,v 1.27 2003/11/29 06:05:56 fireegl Exp $}
        package provide tcldrop::irc $version
        # Initialize variables:
        # Nicks stores the non-channel specific info for each nick:
@@ -703,12 +703,7 @@
 #    Module: irc
 proc ::tcldrop::irc::ischanban {ban channel} {
        variable Bans
-       set element [string tolower $channel,$ban]
-       if {[array get Bans $element] == {}} {
-               return 0
-       } else {
-               return 1
-       }
+       info exists Bans([string tolower $channel,$ban])
 }
 
 #  ischanexempt <exempt> <channel>
@@ -716,6 +711,8 @@
 #      list (not the bot's exemptlist for the channel)
 #    Module: irc
 proc ::tcldrop::irc::ischanexempt {exempt channel} {
+       variable Exempts
+       info exists Exempts([string tolower $channel,$exempt])
 }
 
 #  ischaninvite <invite> <channel>
@@ -723,6 +720,8 @@
 #      list (not the bot's invitelist for the channel)
 #    Module: irc
 proc ::tcldrop::irc::ischaninvite {invite channel} {
+       variable Invites
+       info exists Invites([string tolower $channel,$invite])
 }
 
 #  chanbans <channel>
@@ -730,33 +729,46 @@
 #      a sublist of the form {<ban> <bywho> <age>}. age is seconds from the
 #      bot's POV.
 #    Module: irc
+# FixMe: Add support for the age.
 proc ::tcldrop::irc::chanbans {channel} {
+       set banlist [list]
        variable Bans
-       set element [string tolower $channel]
-       variable ChannelNicks
-       array set botarray $ChannelNicks([string tolower $channel,$::botnick])
-       foreach el [array names Bans $element,*] {
-               array set banlist $Bans($el)
-               set age [expr [clock seconds] - $botarray(join)]
-               lappend thelist [list $banlist(ban) $banlist(creator) $age]
+       foreach b [array names Bans [string tolower $channel],*] {
+               array set baninfo $Bans($b)
+               lappend banlist [list $baninfo(ban) $baninfo(creator) 1]
        }
-       return $thelist
+       return $banlist
 }
 
 #  chanexempts <channel>
 #    Returns: a list of the current exempts on the channel. Each element is
-#      a sublist of the form {<exempts> <bywho> <age>}. age is seconds from the
+#      a sublist of the form {<exempt> <bywho> <age>}. age is seconds from the
 #      bot's POV.
 #    Module: irc
+# FixMe: Add support for the age.
 proc ::tcldrop::irc::chanexempts {channel} {
+       set exemptlist [list]
+       variable Exempts
+       foreach b [array names Exempts [string tolower $channel],*] {
+               array set exemptinfo $Exempts($b)
+               lappend exemptlist [list $exemptinfo(exempt) 
$exemptinfo(creator) 1]
+       }
+       return $exemptlist
 }
 
 #  chaninvites <channel>
 #    Returns: a list of the current invites on the channel. Each element is
-#      a sublist of the form {<invites> <bywho> <age>}. age is seconds from the
+#      a sublist of the form {<invite> <bywho> <age>}. age is seconds from the
 #      bot's POV.
 #    Module: irc
 proc ::tcldrop::irc::chaninvites {channel} {
+       set invitelist [list]
+       variable Invites
+       foreach b [array names Invites [string tolower $channel],*] {
+               array set inviteinfo $Invites($b)
+               lappend invitelist [list $inviteinfo(ban) $inviteinfo(creator) 
1]
+       }
+       return $invitelist
 }
 
 #  resetbans <channel>
@@ -765,6 +777,7 @@
 #      aren't
 #    Returns: nothing
 #    Module: irc
+# FixMe: Complete this.
 proc ::tcldrop::irc::resetbans {channel} {
        variable Bans
 }
@@ -775,7 +788,9 @@
 #      but aren't
 #    Returns: nothing
 #    Module: irc
+# FixMe: Complete this.
 proc ::tcldrop::irc::resetexempts {channel} {
+       variable Exempts
 }
 
 #  resetinvites <channel>
@@ -784,7 +799,9 @@
 #      but aren't
 #    Returns: nothing
 #    Module: irc
+# FixMe: Complete this.
 proc ::tcldrop::irc::resetinvites {channel} {
+       variable Invites
 }
 
 
@@ -815,9 +832,12 @@
 #      central place.
 proc ::tcldrop::irc::nick2hand {nick {channel {*}}} {
        variable Nicks
-       set element [string tolower $nick]
-       array set nickinfo $Nicks($element)
-       return $nickinfo(hand)
+       if {[info exists Nicks([set element [string tolower $nick]])]} {
+               array set nickinfo $Nicks($element)
+               return $nickinfo(handle)
+       } else {
+               return {}
+       }
 }
 
 #  hand2nick <handle> [channel]
@@ -825,67 +845,38 @@
 #      is specified) whose address@hidden matches the given handle; "" is
 #      returned if no match is found. If no channel is specified, all channels
 #      are checked.
-# FixMe: Untested and unmodified.
+# Note: Eggdrop ignores $channel, and so do we.
 proc ::tcldrop::irc::hand2nick {handle {channel {*}}} {
        variable Nicks
-       foreach x [array names Nicks] {
-               array set nickinfo $Nicks($x)
-               if {![string equal -nocase $handle $nickinfo(hand)]} {
-                       set uhost [maskhost 
"$nickinfo(ident)@$nickinfo(address)"]
-                       break
-               }
-               array unset nickinfo
-       }
-       if {![info exists uhost]} { return }
-       variable ChannelNicks
-       set element [string tolower $channel]
-       set found ""
-       foreach el [array names ChannelNicks $element,*] {
-               array set channelinfo $ChannelNicks($el)
-               set nick $channelinfo(nick)
-               if {[string equal -nocase [maskhost [getchanhost $nick]] 
$uhost]} {
-                       set found $nick
-                       break
+       foreach n [array names Nicks] {
+               array set nickinfo $Nicks($n)
+               if {[string equal -nocase $handle $nickinfo(handle)]} {
+                       return $nickinfo(nick)
                }
-               array unset channelinfo
        }
-       return $found
 }
 
 #  handonchan <handle> [channel]
 #    Returns: 1 if the the address@hidden for someone on the channel (or any
 #      channel if no channel name is specified) matches for the handle given;
 #      0 otherwise
-# FixMe: Untested and unmodified.
 proc ::tcldrop::irc::handonchan {handle {channel {*}}} {
-       variable ChannelNicks
-       foreach x [array names Nicks] {
-               array set nickinfo $Nicks($x)
-               if {![string equal -nocase $handle $nickinfo(hand)]} {
-                       set uhost [maskhost 
"$nickinfo(ident)@$nickinfo(address)"]
-                       break
-               }
-               array unset nickinfo
-       }
-       if {![info exists uhost]} { return 0 }
-       set element [string tolower $channel]
-       foreach el [array names ChannelNicks $element,*] {
-               array set channelinfo $ChannelNicks($el)
-               set nick $channelinfo(nick)
-               if {[string equal -nocase [maskhost [getchanhost $nick]] 
$uhost]} {
-                       set found 1
-                       break
+       if {[set nick [hand2nick $handle]] != {}} {
+               variable ChannelNicks
+               if {[array names ChannelNicks [string tolower $channel,$nick]] 
!= {}} {
+                       return 1
+               } else {
+                       return 0
                }
-               array unset channelinfo
+       } else {
+               return 0
        }
-       return [info exists found]
 }
 
 #  getchanhost <nickname> [channel]
 #    Returns: address@hidden of the specified nickname (the nickname is not 
included
 #      in the returned host).  Or "" if none found.
-#      channel is ignored, since Tcldrop stores this particular info in a
-#      central place.
+# Note: Eggdrop ignores $channel, and so do we.
 proc ::tcldrop::irc::getchanhost {nick {channel {*}}} {
        variable Nicks
        if {[info exists Nicks([set nick [string tolower $nick]])]} {
@@ -898,18 +889,21 @@
 #    Returns: timestamp (unixtime format) of when the specified nickname
 #      joined the channel; 0 if the specified user isn't on the channel
 proc ::tcldrop::irc::getchanjoin {nick channel} {
-       if {![botonchan $channel] || ![onchan $nick $channel]} { return 0 }
        variable ChannelNicks
        set element [string tolower $channel,$nick]
-       array set nickinfo $ChannelNicks($element)
-       return "$nickinfo(join)"
+       if {[info exists ChannelNicks($element)]} {
+               array set nickinfo $ChannelNicks($element)
+               return "$nickinfo(jointime)"
+       } else {
+               return 0
+       }
 }
 
 #  onchansplit <nick> [channel]
 #    Returns: 1 if that nick is split from the channel (or any channel if no
 #      channel is specified); 0 otherwise
-proc ::tcldrop::irc::onchansplit {nick {channel {*}}} {
-}
+# FixMe: Add support for this...
+proc ::tcldrop::irc::onchansplit {nick {channel {*}}} { }
 
 #  chanlist <channel> [flags[&chanflags]]
 #    Description: flags are any global flags; the '&' denotes to look for
@@ -925,11 +919,13 @@
 #      part or sign bind, the gone user will still be listed, so you can
 #      check for wasop, isop, etc.
 proc ::tcldrop::irc::chanlist {channel {flags {*}}} {
+       set chanlist [list]
        variable ChannelNicks
-       set chanlist {}
        foreach n [array names ChannelNicks [string tolower "$channel,*"]] {
                array set nickinfo $ChannelNicks($n)
-               if {[matchattr $nickinfo(nick) $flags $channel]} {
+               if {$flags == {*}} {
+                       lappend chanlist $nickinfo(nick)
+               } elseif {[set handle [nick2hand $nickinfo(nick)]] != {*} && 
[matchattr $handle $flags $channel]} {
                        lappend chanlist $nickinfo(nick)
                }
        }
@@ -940,22 +936,26 @@
 #    Returns: number of minutes that person has been idle; 0 if the
 #      specified user isn't on the channel
 proc ::tcldrop::irc::getchanidle {nick channel} {
-       if {![botonchan $channel] || ![onchan $nick $channel]} { return 0 }
        variable ChannelNicks
        set element [string tolower $channel,$nick]
-       array set nickinfo $ChannelNicks($element)
-       set min [string trimleft [clock format [expr [clock seconds] - 
$nickinfo(idle)] -format %M] 0]
-       if {$min == {}} { set min 0 }
-       return $min
+       if {[info exists ChannelNicks($element)]} {
+               array set nickinfo $ChannelNicks($element)
+               return "$nickinfo(idletime)"
+       } else {
+               return 0
+       }
 }
 
 #  getchanmode <channel>
 #    Returns: string of the type "+ntik key" for the channel specified
 proc ::tcldrop::irc::getchanmode {channel} {
-       if {[botonchan $channel]} {
-               variable Channels
-               array set chanmode $Channels([string tolower $channel])
-               return $chanmode(modes)
+       variable Channels
+       set element [string tolower $channel]
+       if {[info exists Channels($element)]} {
+               array set chaninfo $Channels($element)
+               return $chaninfo(chanmodes)
+       } else {
+               return {}
        }
 }
 
@@ -1077,68 +1077,68 @@
 #    Returns: string containing the current topic of the specified channel
 # Proc by address@hidden
 proc ::tcldrop::irc::topic {channel} {
-       if {![botonchan $channel]} { return }
        variable Channels
-       array set chanmode $Channels([string tolower $channel])
-       return $chanmode(topic)
+       set element [string tolower $channel]
+       if {[info exists Channels($element)]} {
+               array set chaninfo $Channels($element)
+               return $chaninfo(topic)
+       } else {
+               return {}
+       }
 }
 
 #  botisop [channel]
 #    Returns: 1 if the bot has ops on the specified channel (or any channel
 #      if no channel is specified); 0 otherwise
-proc ::tcldrop::irc::botisop {{channel {*}}} { ::tcldrop::irc::issomething 
$::botnick $channel op}
+proc ::tcldrop::irc::botisop {{channel {*}}} { is op $::botnick $channel }
 
 #| botishalfop [channel]
 #|   Returns: 1 if the bot has halfops on the specified channel (or any channel
 #|     if no channel is specified); 0 otherwise
-proc ::tcldrop::irc::botishalfop {{channel {*}}} { ::tcldrop::irc::issomething 
$::botnick $channel halfop}
+proc ::tcldrop::irc::botishalfop {{channel {*}}} { is halfop $::botnick 
$channel }
 
 #  botisvoice [channel]
 #    Returns: 1 if the bot has a voice on the specified channel (or any
 #      channel if no channel is specified); 0 otherwise
-proc ::tcldrop::irc::botisvoice {{channel {*}}} { ::tcldrop::irc::issomething 
$::botnick $channel voice}
+proc ::tcldrop::irc::botisvoice {{channel {*}}} { is voice $::botnick $channel 
}
 
 #  isop <nickname> [channel]
 #    Returns: 1 if someone by the specified nickname is on the channel (or
 #      any channel if no channel name is specified) and has ops; 0 otherwise
-proc ::tcldrop::irc::isop {nick {channel {*}}} { ::tcldrop::irc::issomething 
$nick $channel op }
+proc ::tcldrop::irc::isop {nick {channel {*}}} { is op $nick $channel }
 
 #| ishalfop <nickname> [channel]
 #|   Returns: 1 if someone by the specified nickname is on the channel (or
 #|     any channel if no channel name is specified) and has halfops; 0 
otherwise
-proc ::tcldrop::irc::ishalfop {nick {channel {*}}} { 
::tcldrop::irc::issomething $nick $channel halfop }
+proc ::tcldrop::irc::ishalfop {nick {channel {*}}} { is halfop $nick $channel }
+
+#  isvoice <nickname> [channel]
+#    Returns: 1 if someone by that nickname is on the channel (or any
+#      channel if no channel is specified) and has voice (+v); 0 otherwise
+proc ::tcldrop::irc::isvoice {nick {channel {*}}} { is voice $nick $channel }
 
 #  wasop <nickname> <channel>
 #    Returns: 1 if someone that just got opped/deopped in the chan had op
 #      before the modechange; 0 otherwise
+# FixMe: Add support for this.
 proc ::tcldrop::irc::wasop {nick channel} {
 }
 
 #| washalfop <nickname> <channel>
 #|   Returns: 1 if someone that just got halfopped/dehalfopped in the chan
 #|     had halfop before the modechange; 0 otherwise
+# FixMe: Add support for this.
 proc ::tcldrop::irc::washalfop {nick channel} {
 }
 
-#  isvoice <nickname> [channel]
-#    Returns: 1 if someone by that nickname is on the channel (or any
-#      channel if no channel is specified) and has voice (+v); 0 otherwise
-proc ::tcldrop::irc::isvoice {nick {channel {*}}} { 
::tcldrop::irc::issomething $nick $channel voice }
-
 # NOTE: made this proc to handle the (bot)isop/voice/halfop commands, to keep 
the filesize as small as possible ;)
-# Proc by address@hidden
-proc ::tcldrop::irc::issomething {nick channel type} {
-       if {![botonchan $channel]} { return "" }
+proc ::tcldrop::irc::is {type nick {channel {*}}} {
        variable ChannelNicks
-       # FixMe Maybe we should make it return 0 if channel was enterd and it's 
not a valid channel,
-       # ...or just ignore it and check all channels? -eggdrop gives a 
tcl-error
-       set element [string tolower $channel,$nick]
-       foreach el [array names ChannelNicks $element] {
-               array set channick $ChannelNicks($el)
-               if {$channick($type) == 1} { set found 1}
-               array unset channick
+       foreach n [array names ChannelNicks [string tolower $channel,$nick]] {
+               array set channickinfo $ChannelNicks($n)
+               if {$channickinfo($type)} { return 1 }
        }
-       return [info exists found]
+       return 0
 }
 
 ### MSG Commands: