/[tcldrop]/tcldrop/modules/irc/irc.tcl
ViewVC logotype

Diff of /tcldrop/modules/irc/irc.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by fireegl, Sat Nov 29 05:04:29 2003 UTC revision 1.27 by fireegl, Sat Nov 29 06:05:56 2003 UTC
# Line 703  proc ::tcldrop::irc::PRIVMSG {from key a Line 703  proc ::tcldrop::irc::PRIVMSG {from key a
703  #    Module: irc  #    Module: irc
704  proc ::tcldrop::irc::ischanban {ban channel} {  proc ::tcldrop::irc::ischanban {ban channel} {
705          variable Bans          variable Bans
706          set element [string tolower $channel,$ban]          info exists Bans([string tolower $channel,$ban])
         if {[array get Bans $element] == {}} {  
                 return 0  
         } else {  
                 return 1  
         }  
707  }  }
708    
709  #  ischanexempt <exempt> <channel>  #  ischanexempt <exempt> <channel>
# Line 716  proc ::tcldrop::irc::ischanban {ban chan Line 711  proc ::tcldrop::irc::ischanban {ban chan
711  #      list (not the bot's exemptlist for the channel)  #      list (not the bot's exemptlist for the channel)
712  #    Module: irc  #    Module: irc
713  proc ::tcldrop::irc::ischanexempt {exempt channel} {  proc ::tcldrop::irc::ischanexempt {exempt channel} {
714            variable Exempts
715            info exists Exempts([string tolower $channel,$exempt])
716  }  }
717    
718  #  ischaninvite <invite> <channel>  #  ischaninvite <invite> <channel>
# Line 723  proc ::tcldrop::irc::ischanexempt {exemp Line 720  proc ::tcldrop::irc::ischanexempt {exemp
720  #      list (not the bot's invitelist for the channel)  #      list (not the bot's invitelist for the channel)
721  #    Module: irc  #    Module: irc
722  proc ::tcldrop::irc::ischaninvite {invite channel} {  proc ::tcldrop::irc::ischaninvite {invite channel} {
723            variable Invites
724            info exists Invites([string tolower $channel,$invite])
725  }  }
726    
727  #  chanbans <channel>  #  chanbans <channel>
# Line 730  proc ::tcldrop::irc::ischaninvite {invit Line 729  proc ::tcldrop::irc::ischaninvite {invit
729  #      a sublist of the form {<ban> <bywho> <age>}. age is seconds from the  #      a sublist of the form {<ban> <bywho> <age>}. age is seconds from the
730  #      bot's POV.  #      bot's POV.
731  #    Module: irc  #    Module: irc
732    # FixMe: Add support for the age.
733  proc ::tcldrop::irc::chanbans {channel} {  proc ::tcldrop::irc::chanbans {channel} {
734            set banlist [list]
735          variable Bans          variable Bans
736          set element [string tolower $channel]          foreach b [array names Bans [string tolower $channel],*] {
737          variable ChannelNicks                  array set baninfo $Bans($b)
738          array set botarray $ChannelNicks([string tolower $channel,$::botnick])                  lappend banlist [list $baninfo(ban) $baninfo(creator) 1]
         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]  
739          }          }
740          return $thelist          return $banlist
741  }  }
742    
743  #  chanexempts <channel>  #  chanexempts <channel>
744  #    Returns: a list of the current exempts on the channel. Each element is  #    Returns: a list of the current exempts on the channel. Each element is
745  #      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
746  #      bot's POV.  #      bot's POV.
747  #    Module: irc  #    Module: irc
748    # FixMe: Add support for the age.
749  proc ::tcldrop::irc::chanexempts {channel} {  proc ::tcldrop::irc::chanexempts {channel} {
750            set exemptlist [list]
751            variable Exempts
752            foreach b [array names Exempts [string tolower $channel],*] {
753                    array set exemptinfo $Exempts($b)
754                    lappend exemptlist [list $exemptinfo(exempt) $exemptinfo(creator) 1]
755            }
756            return $exemptlist
757  }  }
758    
759  #  chaninvites <channel>  #  chaninvites <channel>
760  #    Returns: a list of the current invites on the channel. Each element is  #    Returns: a list of the current invites on the channel. Each element is
761  #      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
762  #      bot's POV.  #      bot's POV.
763  #    Module: irc  #    Module: irc
764  proc ::tcldrop::irc::chaninvites {channel} {  proc ::tcldrop::irc::chaninvites {channel} {
765            set invitelist [list]
766            variable Invites
767            foreach b [array names Invites [string tolower $channel],*] {
768                    array set inviteinfo $Invites($b)
769                    lappend invitelist [list $inviteinfo(ban) $inviteinfo(creator) 1]
770            }
771            return $invitelist
772  }  }
773    
774  #  resetbans <channel>  #  resetbans <channel>
# Line 765  proc ::tcldrop::irc::chaninvites {channe Line 777  proc ::tcldrop::irc::chaninvites {channe
777  #      aren't  #      aren't
778  #    Returns: nothing  #    Returns: nothing
779  #    Module: irc  #    Module: irc
780    # FixMe: Complete this.
781  proc ::tcldrop::irc::resetbans {channel} {  proc ::tcldrop::irc::resetbans {channel} {
782          variable Bans          variable Bans
783  }  }
# Line 775  proc ::tcldrop::irc::resetbans {channel} Line 788  proc ::tcldrop::irc::resetbans {channel}
788  #      but aren't  #      but aren't
789  #    Returns: nothing  #    Returns: nothing
790  #    Module: irc  #    Module: irc
791    # FixMe: Complete this.
792  proc ::tcldrop::irc::resetexempts {channel} {  proc ::tcldrop::irc::resetexempts {channel} {
793            variable Exempts
794  }  }
795    
796  #  resetinvites <channel>  #  resetinvites <channel>
# Line 784  proc ::tcldrop::irc::resetexempts {chann Line 799  proc ::tcldrop::irc::resetexempts {chann
799  #      but aren't  #      but aren't
800  #    Returns: nothing  #    Returns: nothing
801  #    Module: irc  #    Module: irc
802    # FixMe: Complete this.
803  proc ::tcldrop::irc::resetinvites {channel} {  proc ::tcldrop::irc::resetinvites {channel} {
804            variable Invites
805  }  }
806    
807    
# Line 815  proc ::tcldrop::irc::botonchan {{channel Line 832  proc ::tcldrop::irc::botonchan {{channel
832  #      central place.  #      central place.
833  proc ::tcldrop::irc::nick2hand {nick {channel {*}}} {  proc ::tcldrop::irc::nick2hand {nick {channel {*}}} {
834          variable Nicks          variable Nicks
835          set element [string tolower $nick]          if {[info exists Nicks([set element [string tolower $nick]])]} {
836          array set nickinfo $Nicks($element)                  array set nickinfo $Nicks($element)
837          return $nickinfo(hand)                  return $nickinfo(handle)
838            } else {
839                    return {}
840            }
841  }  }
842    
843  #  hand2nick <handle> [channel]  #  hand2nick <handle> [channel]
# Line 825  proc ::tcldrop::irc::nick2hand {nick {ch Line 845  proc ::tcldrop::irc::nick2hand {nick {ch
845  #      is specified) whose nick!user@host matches the given handle; "" is  #      is specified) whose nick!user@host matches the given handle; "" is
846  #      returned if no match is found. If no channel is specified, all channels  #      returned if no match is found. If no channel is specified, all channels
847  #      are checked.  #      are checked.
848  # FixMe: Untested and unmodified.  # Note: Eggdrop ignores $channel, and so do we.
849  proc ::tcldrop::irc::hand2nick {handle {channel {*}}} {  proc ::tcldrop::irc::hand2nick {handle {channel {*}}} {
850          variable Nicks          variable Nicks
851          foreach x [array names Nicks] {          foreach n [array names Nicks] {
852                  array set nickinfo $Nicks($x)                  array set nickinfo $Nicks($n)
853                  if {![string equal -nocase $handle $nickinfo(hand)]} {                  if {[string equal -nocase $handle $nickinfo(handle)]} {
854                          set uhost [maskhost "$nickinfo(ident)@$nickinfo(address)"]                          return $nickinfo(nick)
                         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  
855                  }                  }
                 array unset channelinfo  
856          }          }
         return $found  
857  }  }
858    
859  #  handonchan <handle> [channel]  #  handonchan <handle> [channel]
860  #    Returns: 1 if the the nick!user@host for someone on the channel (or any  #    Returns: 1 if the the nick!user@host for someone on the channel (or any
861  #      channel if no channel name is specified) matches for the handle given;  #      channel if no channel name is specified) matches for the handle given;
862  #      0 otherwise  #      0 otherwise
 # FixMe: Untested and unmodified.  
863  proc ::tcldrop::irc::handonchan {handle {channel {*}}} {  proc ::tcldrop::irc::handonchan {handle {channel {*}}} {
864          variable ChannelNicks          if {[set nick [hand2nick $handle]] != {}} {
865          foreach x [array names Nicks] {                  variable ChannelNicks
866                  array set nickinfo $Nicks($x)                  if {[array names ChannelNicks [string tolower $channel,$nick]] != {}} {
867                  if {![string equal -nocase $handle $nickinfo(hand)]} {                          return 1
868                          set uhost [maskhost "$nickinfo(ident)@$nickinfo(address)"]                  } else {
869                          break                          return 0
                 }  
                 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  
870                  }                  }
871                  array unset channelinfo          } else {
872                    return 0
873          }          }
         return [info exists found]  
874  }  }
875    
876  #  getchanhost <nickname> [channel]  #  getchanhost <nickname> [channel]
877  #    Returns: user@host of the specified nickname (the nickname is not included  #    Returns: user@host of the specified nickname (the nickname is not included
878  #      in the returned host).  Or "" if none found.  #      in the returned host).  Or "" if none found.
879  #      channel is ignored, since Tcldrop stores this particular info in a  # Note: Eggdrop ignores $channel, and so do we.
 #      central place.  
880  proc ::tcldrop::irc::getchanhost {nick {channel {*}}} {  proc ::tcldrop::irc::getchanhost {nick {channel {*}}} {
881          variable Nicks          variable Nicks
882          if {[info exists Nicks([set nick [string tolower $nick]])]} {          if {[info exists Nicks([set nick [string tolower $nick]])]} {
# Line 898  proc ::tcldrop::irc::getchanhost {nick { Line 889  proc ::tcldrop::irc::getchanhost {nick {
889  #    Returns: timestamp (unixtime format) of when the specified nickname  #    Returns: timestamp (unixtime format) of when the specified nickname
890  #      joined the channel; 0 if the specified user isn't on the channel  #      joined the channel; 0 if the specified user isn't on the channel
891  proc ::tcldrop::irc::getchanjoin {nick channel} {  proc ::tcldrop::irc::getchanjoin {nick channel} {
         if {![botonchan $channel] || ![onchan $nick $channel]} { return 0 }  
892          variable ChannelNicks          variable ChannelNicks
893          set element [string tolower $channel,$nick]          set element [string tolower $channel,$nick]
894          array set nickinfo $ChannelNicks($element)          if {[info exists ChannelNicks($element)]} {
895          return "$nickinfo(join)"                  array set nickinfo $ChannelNicks($element)
896                    return "$nickinfo(jointime)"
897            } else {
898                    return 0
899            }
900  }  }
901    
902  #  onchansplit <nick> [channel]  #  onchansplit <nick> [channel]
903  #    Returns: 1 if that nick is split from the channel (or any channel if no  #    Returns: 1 if that nick is split from the channel (or any channel if no
904  #      channel is specified); 0 otherwise  #      channel is specified); 0 otherwise
905  proc ::tcldrop::irc::onchansplit {nick {channel {*}}} {  # FixMe: Add support for this...
906  }  proc ::tcldrop::irc::onchansplit {nick {channel {*}}} { }
907    
908  #  chanlist <channel> [flags[&chanflags]]  #  chanlist <channel> [flags[&chanflags]]
909  #    Description: flags are any global flags; the '&' denotes to look for  #    Description: flags are any global flags; the '&' denotes to look for
# Line 925  proc ::tcldrop::irc::onchansplit {nick { Line 919  proc ::tcldrop::irc::onchansplit {nick {
919  #      part or sign bind, the gone user will still be listed, so you can  #      part or sign bind, the gone user will still be listed, so you can
920  #      check for wasop, isop, etc.  #      check for wasop, isop, etc.
921  proc ::tcldrop::irc::chanlist {channel {flags {*}}} {  proc ::tcldrop::irc::chanlist {channel {flags {*}}} {
922            set chanlist [list]
923          variable ChannelNicks          variable ChannelNicks
         set chanlist {}  
924          foreach n [array names ChannelNicks [string tolower "$channel,*"]] {          foreach n [array names ChannelNicks [string tolower "$channel,*"]] {
925                  array set nickinfo $ChannelNicks($n)                  array set nickinfo $ChannelNicks($n)
926                  if {[matchattr $nickinfo(nick) $flags $channel]} {                  if {$flags == {*}} {
927                            lappend chanlist $nickinfo(nick)
928                    } elseif {[set handle [nick2hand $nickinfo(nick)]] != {*} && [matchattr $handle $flags $channel]} {
929                          lappend chanlist $nickinfo(nick)                          lappend chanlist $nickinfo(nick)
930                  }                  }
931          }          }
# Line 940  proc ::tcldrop::irc::chanlist {channel { Line 936  proc ::tcldrop::irc::chanlist {channel {
936  #    Returns: number of minutes that person has been idle; 0 if the  #    Returns: number of minutes that person has been idle; 0 if the
937  #      specified user isn't on the channel  #      specified user isn't on the channel
938  proc ::tcldrop::irc::getchanidle {nick channel} {  proc ::tcldrop::irc::getchanidle {nick channel} {
         if {![botonchan $channel] || ![onchan $nick $channel]} { return 0 }  
939          variable ChannelNicks          variable ChannelNicks
940          set element [string tolower $channel,$nick]          set element [string tolower $channel,$nick]
941          array set nickinfo $ChannelNicks($element)          if {[info exists ChannelNicks($element)]} {
942          set min [string trimleft [clock format [expr [clock seconds] - $nickinfo(idle)] -format %M] 0]                  array set nickinfo $ChannelNicks($element)
943          if {$min == {}} { set min 0 }                  return "$nickinfo(idletime)"
944          return $min          } else {
945                    return 0
946            }
947  }  }
948    
949  #  getchanmode <channel>  #  getchanmode <channel>
950  #    Returns: string of the type "+ntik key" for the channel specified  #    Returns: string of the type "+ntik key" for the channel specified
951  proc ::tcldrop::irc::getchanmode {channel} {  proc ::tcldrop::irc::getchanmode {channel} {
952          if {[botonchan $channel]} {          variable Channels
953                  variable Channels          set element [string tolower $channel]
954                  array set chanmode $Channels([string tolower $channel])          if {[info exists Channels($element)]} {
955                  return $chanmode(modes)                  array set chaninfo $Channels($element)
956                    return $chaninfo(chanmodes)
957            } else {
958                    return {}
959          }          }
960  }  }
961    
# Line 1077  proc ::tcldrop::irc::flushmode {{channel Line 1077  proc ::tcldrop::irc::flushmode {{channel
1077  #    Returns: string containing the current topic of the specified channel  #    Returns: string containing the current topic of the specified channel
1078  # Proc by Papillon@EFNet  # Proc by Papillon@EFNet
1079  proc ::tcldrop::irc::topic {channel} {  proc ::tcldrop::irc::topic {channel} {
         if {![botonchan $channel]} { return }  
1080          variable Channels          variable Channels
1081          array set chanmode $Channels([string tolower $channel])          set element [string tolower $channel]
1082          return $chanmode(topic)          if {[info exists Channels($element)]} {
1083                    array set chaninfo $Channels($element)
1084                    return $chaninfo(topic)
1085            } else {
1086                    return {}
1087            }
1088  }  }
1089    
1090  #  botisop [channel]  #  botisop [channel]
1091  #    Returns: 1 if the bot has ops on the specified channel (or any channel  #    Returns: 1 if the bot has ops on the specified channel (or any channel
1092  #      if no channel is specified); 0 otherwise  #      if no channel is specified); 0 otherwise
1093  proc ::tcldrop::irc::botisop {{channel {*}}} { ::tcldrop::irc::issomething $::botnick $channel op}  proc ::tcldrop::irc::botisop {{channel {*}}} { is op $::botnick $channel }
1094    
1095  #| botishalfop [channel]  #| botishalfop [channel]
1096  #|   Returns: 1 if the bot has halfops on the specified channel (or any channel  #|   Returns: 1 if the bot has halfops on the specified channel (or any channel
1097  #|     if no channel is specified); 0 otherwise  #|     if no channel is specified); 0 otherwise
1098  proc ::tcldrop::irc::botishalfop {{channel {*}}} { ::tcldrop::irc::issomething $::botnick $channel halfop}  proc ::tcldrop::irc::botishalfop {{channel {*}}} { is halfop $::botnick $channel }
1099    
1100  #  botisvoice [channel]  #  botisvoice [channel]
1101  #    Returns: 1 if the bot has a voice on the specified channel (or any  #    Returns: 1 if the bot has a voice on the specified channel (or any
1102  #      channel if no channel is specified); 0 otherwise  #      channel if no channel is specified); 0 otherwise
1103  proc ::tcldrop::irc::botisvoice {{channel {*}}} { ::tcldrop::irc::issomething $::botnick $channel voice}  proc ::tcldrop::irc::botisvoice {{channel {*}}} { is voice $::botnick $channel }
1104    
1105  #  isop <nickname> [channel]  #  isop <nickname> [channel]
1106  #    Returns: 1 if someone by the specified nickname is on the channel (or  #    Returns: 1 if someone by the specified nickname is on the channel (or
1107  #      any channel if no channel name is specified) and has ops; 0 otherwise  #      any channel if no channel name is specified) and has ops; 0 otherwise
1108  proc ::tcldrop::irc::isop {nick {channel {*}}} { ::tcldrop::irc::issomething $nick $channel op }  proc ::tcldrop::irc::isop {nick {channel {*}}} { is op $nick $channel }
1109    
1110  #| ishalfop <nickname> [channel]  #| ishalfop <nickname> [channel]
1111  #|   Returns: 1 if someone by the specified nickname is on the channel (or  #|   Returns: 1 if someone by the specified nickname is on the channel (or
1112  #|     any channel if no channel name is specified) and has halfops; 0 otherwise  #|     any channel if no channel name is specified) and has halfops; 0 otherwise
1113  proc ::tcldrop::irc::ishalfop {nick {channel {*}}} { ::tcldrop::irc::issomething $nick $channel halfop }  proc ::tcldrop::irc::ishalfop {nick {channel {*}}} { is halfop $nick $channel }
1114    
1115    #  isvoice <nickname> [channel]
1116    #    Returns: 1 if someone by that nickname is on the channel (or any
1117    #      channel if no channel is specified) and has voice (+v); 0 otherwise
1118    proc ::tcldrop::irc::isvoice {nick {channel {*}}} { is voice $nick $channel }
1119    
1120  #  wasop <nickname> <channel>  #  wasop <nickname> <channel>
1121  #    Returns: 1 if someone that just got opped/deopped in the chan had op  #    Returns: 1 if someone that just got opped/deopped in the chan had op
1122  #      before the modechange; 0 otherwise  #      before the modechange; 0 otherwise
1123    # FixMe: Add support for this.
1124  proc ::tcldrop::irc::wasop {nick channel} {  proc ::tcldrop::irc::wasop {nick channel} {
1125  }  }
1126    
1127  #| washalfop <nickname> <channel>  #| washalfop <nickname> <channel>
1128  #|   Returns: 1 if someone that just got halfopped/dehalfopped in the chan  #|   Returns: 1 if someone that just got halfopped/dehalfopped in the chan
1129  #|     had halfop before the modechange; 0 otherwise  #|     had halfop before the modechange; 0 otherwise
1130    # FixMe: Add support for this.
1131  proc ::tcldrop::irc::washalfop {nick channel} {  proc ::tcldrop::irc::washalfop {nick channel} {
1132  }  }
1133    
 #  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 }  
   
1134  # NOTE: made this proc to handle the (bot)isop/voice/halfop commands, to keep the filesize as small as possible ;)  # NOTE: made this proc to handle the (bot)isop/voice/halfop commands, to keep the filesize as small as possible ;)
1135  # Proc by Papillon@EFNet  proc ::tcldrop::irc::is {type nick {channel {*}}} {
 proc ::tcldrop::irc::issomething {nick channel type} {  
         if {![botonchan $channel]} { return "" }  
1136          variable ChannelNicks          variable ChannelNicks
1137          # FixMe Maybe we should make it return 0 if channel was enterd and it's not a valid channel,          foreach n [array names ChannelNicks [string tolower $channel,$nick]] {
1138          # ...or just ignore it and check all channels? -eggdrop gives a tcl-error                  array set channickinfo $ChannelNicks($n)
1139          set element [string tolower $channel,$nick]                  if {$channickinfo($type)} { return 1 }
         foreach el [array names ChannelNicks $element] {  
                 array set channick $ChannelNicks($el)  
                 if {$channick($type) == 1} { set found 1}  
                 array unset channick  
1140          }          }
1141          return [info exists found]          return 0
1142  }  }
1143    
1144  ### MSG Commands:  ### MSG Commands:

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26