#
# KLined.TCL - Version 1.1
# By Ian Kaney - ikaney@uk.defiant.org
# Revised to level 1.1 by AmnesiAc - amnesiac@unforgettable.com
#
# Even at the best of times, your bot will get k-lined by one operator or
# another on a server you're running your bot on. This script will 'hopefully'
# handle this by removing it from your bot's server list when it detects
# you've been k-lined there. Thus, stopping IRC server admins getting
# rather peeved at the constant connects from your host.
#
# USAGE:
#      The actual handling of removing the server from your server list
#      and writing it to the 'klines' file is handled automatically when
#      your bot receives the k-line signal, but there are some DCC commands
#      that have been added, these are:
#
#      .klines - Lists the 'klines' file showing servers that your bot
#                has registered as being k-lined on.
#      .unkline <server> - Removes the k-line from the server *joke* ;)
#                         Actually, this removes the server from the list
#                         of servers to remove.
#
#
# Revision Level
#
# 1.1  Revision by AmnesiAc
#      Renamed the klines file to nick.klines to prevent multiple bots
#      in the same directory but using different vhosts from sharing each
#      others klines file, and hence incorrectly sharing each others klines.
#
#      Improved the layout slightly to make it a little more readable
#      *so I could see what was going on*

# Bindings
# ---
bind load - server remove_kservers
bind raw - 465 woah_klined
bind dcc n klines list_kservers
bind dcc n unkline unkline_server

# Variables
# ---
# Change this to suite your tastes - if you can't be bothered, or
# don't know how, leave it.
set kfile "klines"


# 1.1 modifications begin
set kfile $nick.$kfile
# 1.1 modifications end

proc list_kservers {handle idx args} {
  global kfile
  putcmdlog "#$handle# klines"
  set fd [open $kfile r]
  set kservers { }
  while {![eof $fd]} {
    set tmp [gets $fd]
    if {[eof $fd]} {break}
    set kservers [lappend kservers [string trim $tmp]]
  }
  close $fd
  if {[llength $kservers] == 0} {
    putdcc $idx "No k-lined servers."
    return 0
  }
  putdcc $idx "My k-lined server list:\n"
  foreach tmp $kservers {
    putdcc $idx $tmp
  }
}

proc unkline_server {handle idx args} {
  global kfile
  set kservers {}
  set fd [open $kfile r]
  set rem [lindex $args 0]
  putcmdlog "#$handle# unkline $rem"
  while {![eof $fd]} {
    set tmp [gets $fd]
    if {[eof $fd]} {break}
    set kservers [lappend kservers [string trim $tmp]]
  }
  close $fd
  set fd [open $kfile w]
  set flag "0"
  foreach tmp $kservers {
    if {$tmp == $rem} {
      set flag "1"
    }
    if {$tmp != $rem} {
      puts $fd $tmp
    }
  }
  close $fd
  if {$flag == "0"} {
    putdcc $idx "Could not find $rem in the k-lined server list."
  }
  if {$flag == "1"} {
    putdcc $idx "Removed server $rem from k-lined server list."
  }
}

proc remove_kservers {module} {
  global kfile server servers
  if {[catch {set fd [open $kfile r]}] != 0} {
    set fd [open $kfile w]
    close $fd
    set fd [open $kfile r]
  }
  while {![eof $fd]} {
    set from [string trim [gets $fd]]
    set name "*$from*"
    if {[eof $fd]} {break}
    for {set j 0} {$j >= 0} {incr j} {
      set x [lsearch $servers $name]
      if {$x >= 0} {
        set servers [lreplace $servers $x $x]
      }
      if {$x < 0} {
        if {$j >= 0} {
          putlog "Removed server: $from"
	  }
	  break
      }
    }
  }
  close $fd
  return 1
}

proc woah_klined {from keyword arg} {
  global kfile server servers
  set kservers {}
  set fd [open $kfile r]

  while {![eof $fd]} {
    set tmp [gets $fd]
    if {[eof $fd]} {break}
    set kservers [lappend kservers [string trim $tmp]]
  }
  close $fd
  set flag "0"
  foreach tmp $kservers {
    if {$tmp == $from} {
      set flag "1"
    }
  }
  if {$flag != "1"} {
    set fd [open $kfile a]
    puts $fd $from
    close $fd
  }
  set name "*$from*"
  for {set j 0} {$j >= 0} {incr j} {
    set x [lsearch $servers $name]
    if {$x >= 0} {
      set servers [lreplace $servers $x $x]
    }
    if {$x <= 0} {
      if {$j >= 0} {
        putlog "Removed server: $from"
      }
      break
    }
  }
  return 1
}

putlog "TCL loaded: klined1.1.tcl"
remove_kservers server