####################################################
# by wiebe @ QuakeNet
#
# eggdrop's native server list, 'set servers ..' in the conf is just .. limited to say the least
# this script provides dcc server command to change the bot's server list on the fly
# entries include name (handy when the host/ip doesnt reveal this),
# rank (servers are tried from highest to lowest ranking, rank 0 means the entry wont be used),
# port, and password
#
####################################################

####################################################
# server:dcc
####################################################
bind dcc n|- server server:dcc
proc server:dcc { h i t } {
  if {![valididx $i]} { return 0 }
  set t [split $t]; set c [lindex $t 0]; set t [join [lrange $t 1 end]]
  if {$c == "add"} { set o [server:add $h $t]
  } elseif {$c == "del"} { set o [server:del $h $t]
  } elseif {$c == "list"} { set o [server:list $h $t]
  } elseif {$c == "mod"} { set o [server:mod $h $t]
  } elseif {$c == "help"} { set o [server:help $t]
  } else {
    if {$c != ""} { lappend o "server: unknown subcommand $c" }
    lappend o "server: usage server add|del|list|mod|help"
  }
  foreach l $o { putidx $i $l }
  return 1
}


####################################################
# server:add
####################################################
proc server:add { h t } {
  set t [split $t]; set n [lindex $t 0]; set i [lindex $t 1]; set p [lindex $t 2]; set x [lindex $t 3]
  if {$p == ""} { set p 6667 }
  if {$x == ""} { set x none }
  if {$n == ""} {
    lappend o "server: server add <name> <host> \[<port>\] \[<pass>\]"
    lappend o "server: adds a server entry to the list under the given name. name is the name associated with the entry (e.g. server.cc), host is the hostname or IP to connect to (e.g. irc.net.cc or 1.2.3.4), port is the port to connect to (e.g. 6665, default 6667), pass is the password to connect (e.g. foobar)."
  } elseif {![regexp -- {^[a-zA-Z0-9\-_.]+$} $n]} {
    lappend o "server: invalid name $n"
    lappend o "server: usage add <name> <host> \[<port>\] \[<pass>\]"
    lappend o "server: name may only contain \"a-zA-Z0-9\" and \"-_.\""
    lappend o "server: name of the entry the info about this server is stored in the list"
  } elseif {$i == ""} {
    lappend o "server: usage add <name> <host> \[<port>\] \[<pass>\]"
    lappend o "server: host is the address for the IRC server, either an IP or a resolvable hostname to connect to"
  } elseif {![regexp -- {^[a-zA-Z0-9\-_.:]+$} $i]} {
    lappend o "server: invalid host $i"
    lappend o "server: usage add <name> <host> \[<port>\] \[<pass>\]"
    lappend o "server: host may only contain \"a-zA-Z0-9\" and \"-_.:\""
    lappend o "server: host is the address for the IRC server, either an IP or a resolvable hostname to connect to"
  } elseif {![string is digit $p] || $p < 1 || $p > 65536} {
    lappend o "server: invalid port $p"
    lappend o "server: usage add <name> <host> \[<port>\] \[<pass>\]"
  } else {
    global serverdb; set nc $n; set n [string tolower $n]
    if {[info exists serverdb($n)]} {
      set l [split $serverdb($n)]
      set nl [lindex $l 0]; set nr [lindex $l 1]; set ni [lindex $l 2]
      set np [lindex $l 3]; set nx [lindex $l 4]; set nt [server:ts [lindex $l 5]]
      lappend o "server: an entry with name $nc already exists"
      lappend o "  name=$nl  rank=$nr  host=$ni  port=$np  pass=$nx  last=$nt"
      lappend o "server: overwriting old entry.."
    }
    set r 1; set serverdb($n) "$nc $r $i $p $x 0"
    server:save
    lappend o "server: added entry  name=$nc  rank=$r  host=$i  port=$p  pass=$x"
  }
  return $o
}


####################################################
# server:del
####################################################
proc server:del { h t } {
  global serverdb; set m [array size serverdb]; set f ""; set d ""
  foreach n [split $t] {
    if {![string is digit $n]} { set f "$n is not a number"; break }
    if {$n < 1 || $n > $m} { set f "$n is out of range, must be between 1 and $m"; break }
    if {[lsearch -exact $d $n] == "-1"} { lappend d $n }
  }
  if {$t == ""} {
    lappend o "server: server del <N> \[<N> .. <N>\]"
    lappend o "server: deletes one or more entries from the list by their entry number."
  } elseif {$f != ""} {
    lappend o "server: $f"
    lappend o "server: usage del <N> \[<N> .. <N>\]"
  } else {
    lappend o "server: deleting entries.."
    foreach n [lsort -decreasing -dictionary $d] {
      set e [lindex [lsort -dictionary [array names serverdb]] [expr $n -1]]
      set l [split $serverdb($e)]; unset serverdb($e)
      set nl [lindex $l 0]; set nr [lindex $l 1]; set ni [lindex $l 2]
      set np [lindex $l 3]; set nx [lindex $l 4]; set nt [server:ts [lindex $l 5]]
      lappend o "  #$n  name=$nl  rank=$nr  host=$ni  port=$np  pass=$nx  last=$nt"
    }
    server:save
    lappend o "server: deleted [llength $d] entries"
  }
  return $o
}


####################################################
# server:list
####################################################
proc server:list { h t } {
  set t [split $t]; set n [lindex $t 0]; set r [lindex $t 1]; set i [lindex $t 2]; set p [lindex $t 3]
  if {$r == ""} { set r * }; if {$i == ""} { set i * }; if {$p == ""} { set p * }
  if {$n == ""} { set n *; lappend o "server: usage list \[<name>\] \[<rank>\] \[<host>\] \[<port>\]" }
  global serverdb serveraddress; set a(1) ""; set a(2) ""; lappend a(3) 4; set a(4) ""; set a(5) ""; set a(6) ""
  set si [split $serveraddress :]; set sp [lindex $si 1]; set si [lindex $si 0]; set z 0; set y 0; set x ""
  lappend o "server: listing entries matching criteria:  name=$n  rank=$r  host=$i  port=$p"
  foreach e [lsort -dictionary [array names serverdb]] {
    incr z
    set l [split $serverdb($e)]
    set nl [lindex $l 0]; set nr [lindex $l 1]; set ni [lindex $l 2]
    set np [lindex $l 3]; set nx [lindex $l 4]; set nt [server:ts [lindex $l 5]]
    lappend a(1) [string length $z]; lappend a(2) [string length $nl]; lappend a(3) [string length $nr]
    lappend a(4) [string length $ni]; lappend a(5) [string length $np]; lappend a(6) [string length $nx]
    if {![string match -nocase $n $nl]} { continue }; if {![string match -nocase $r $nr]} { continue }
    if {![string match -nocase $i $ni]} { continue }; if {![string match -nocase $p $np]} { continue }
    if {"$ni $np" == "$si $sp"} { set nt CONNECTED }
    incr y
    lappend x "[expr $nr * -1 +9] #$z $nl $nr $ni $np $nx $nt"
  }
  foreach e "1 2 3 4 5 6" { set a($e) [lindex [lsort -dictionary $a($e)] end] }
  set x [lsort -dictionary $x]; set x [linsert $x 0 "0 # NAME RANK HOST PORT PASS LAST CONNECT"]
  foreach e $x {
    set e [split $e]; set z [lindex $e 1]; set l [lrange $e 2 end]
    set nl [lindex $l 0]; set nr [lindex $l 1]; set ni [lindex $l 2]
    set np [lindex $l 3]; set nx [lindex $l 4]; set nt [join [lrange $l 5 end]]
    set s1 [string repeat " " [expr $a(1) - [string length $z] +1]]
    set s2 [string repeat " " [expr $a(2) - [string length $nl]]]
    set s3 [string repeat " " [expr $a(3) - [string length $nr]]]
    set s4 [string repeat " " [expr $a(4) - [string length $ni]]]
    set s5 [string repeat " " [expr $a(5) - [string length $np]]]
    set s6 [string repeat " " [expr $a(6) - [string length $nx]]]
    lappend o "  $z $s1 $nl $s2 $nr $s3 $ni $s4 $np $s5 $nx $s6 $nt"
  }
  lappend o "server: matched $y / [array size serverdb] entries"
  return $o
}


####################################################
# server:mod
####################################################
proc server:mod { h t } {
  global serverdb
  if {$t == ""} {
    lappend o "server: server mod <N> \[+|-\]<rank> \[<N> \[+|-\]<rank> ..\]"
    lappend o "server: changes the rank for one or more servers by their entry number. rank can be an absolute value (e.g. 2) to change the rank to, or a modifier (e.g. +2 or -3) to change the current rank. servers with a rank 9 have the highest priority, servers with rank 1 have the lowest priority, and servers with rank 0 are not used."
  } else {
    set m [array size serverdb]; set t [split $t]; set n [lindex $t 0]; set v [lindex $t 1]
    foreach "n v" $t {
      if {![string is digit $n] || $n < 1} {
        lappend o "server: invalid entry number $n"
        lappend o "server: usage mod <N> \[+|-\]<rank> \[<N> \[+|-\]<rank> ..\]"
        break
      } elseif {$n > $m} {
        lappend o "server: no entry with number $n"
        lappend o "server: usage mod <N> \[+|-\]<rank> \[<N> \[+|-\]<rank> ..\]"
        break
      } elseif {$v == ""} {
        lappend o "server: no rank specified"
        lappend o "server: usage mod <N> \[+|-\]<rank> \[<N> \[+|-\]<rank> ..\]"
        break
      } elseif {![regexp -- {^[+-]?\d$} $v]} {
        lappend o "server: invalid rank $v"
        lappend o "server: usage mod <N> \[+|-\]<rank> \[<N> \[+|-\]<rank> ..\]"
        lappend o "server: rank can be an absolute value from 0 to 9 (e.g. 2) to change the rank to, or a modifier (e.g. +2 or -3) to change the current rank."
        break
      }
      set e [lindex [lsort -dictionary [array names serverdb]] [expr $n -1]]; set l [split $serverdb($e)]
      set nl [lindex $l 0]; set nr [lindex $l 1]; set ni [lindex $l 2]
      set np [lindex $l 3]; set nx [lindex $l 4]; set nt [lindex $l 5]
      if {![string is digit $nr]} { set nr 0 }
      if {[string is digit $v]} { set r $v } else { set r [expr $nr $v] }
      if {$r < 0} { set r 0 }; if {$r > 9} { set r 9 }
      set serverdb($e) "$nl $r $ni $np $nx $nt"; set nt [server:ts $nt]
      lappend o "server: #$n  name=$nl  rank=$nr->$r  host=$ni  port=$np  pass=$nx  last=$nt"
    }
    server:save
  }
  return $o
}


####################################################
# server:help
####################################################
proc server:help { t } {
  set c [string tolower [lindex [split $t] 0]]
  if {$c == "add"} {
    lappend o "server: server add <name> <host> \[<port>\] \[<pass>\]"
    lappend o "server: adds a server entry to the list under the given name. name is the name associated with the entry (e.g. server.cc), host is the hostname or IP to connect to (e.g. irc.net.cc or 1.2.3.4), port is the port to connect to (e.g. 6665, default 6667), pass is the password to connect (e.g. foobar)."
  } elseif {$c == "del"} {
    lappend o "server: server del <N> \[<N> .. <N>\]"
    lappend o "server: deletes one or more entries from the list by their entry number."
  } elseif {$c == "list"} {
    lappend o "server: server list \[<name>\] \[<rank>\] \[<host>\] \[<port>\]"
    lappend o "server: list matching server entries."
  } elseif {$c == "mod"} {
    lappend o "server: server mod <N> \[+|-\]<rank> \[<N> \[+|-\]<rank> ..\]"
    lappend o "server: changes the rank for one or more servers by their entry number. rank can be an absolute value (e.g. 2) to change the rank to, or a modifier (e.g. +2 or -3) to change the current rank. servers with a rank 9 have the highest priority, servers with rank 1 have the lowest priority, and servers with rank 0 are not used."
  } else {
    lappend o "server: usage help add|del|list|mod"
    lappend o "server: shows help in general or for the given subcommand"
  }
  return $o
}


####################################################
# server:set
####################################################
proc server:set { } {
  global servers serveraddress serverdb; set ts [clock seconds]; set s ""
  foreach e [array names serverdb] {
    set l [split $serverdb($e)]
    set nl [lindex $l 0]; set nr [lindex $l 1]; set ni [lindex $l 2]
    set np [lindex $l 3]; set nx [lindex $l 4]; set nt [lindex $l 5]
    if {$nr == 0} { continue }
    if {![string is digit $nt]} { set nt 0 }
    if {[expr $ts - $nt] < 600} { set nr 0 }
    if {"$ni $np" == [lrange [split $serveraddress :] 0 1]} { continue }
    lappend s "[expr $nr * -1 +9] $ni:$np:$nx"
  }
  if {$s == ""} { return 0 }
  set servers ""
  if {$serveraddress != ""} { lappend servers $serveraddress }
  foreach e [lsort -dictionary $s] { lappend servers [lindex [split $e] 1] }
}


####################################################
# server:evnt
####################################################
bind evnt -|- init-server server:evnt
bind evnt -|- disconnect-server server:evnt
proc server:evnt { t } {
  global serverdb servers serveraddress server-online
  set i [split $serveraddress :]; set p [lindex $i 1]; set i [lindex $i 0]; set c [clock seconds]
  if {$t == "disconnect-server"} {
    if {[expr $c - ${server-online}] < 600} { return 0 }
    server:set
  } elseif {$t == "init-server"} {
    set u ""
    foreach e $servers {
      set e [split $e :]; set ni [lindex $e 0]; set np [lindex $e 1]; lappend u "$ni $np"
      if {"$i $p" == "$ni $np"} { break }
    }
    foreach e [array names serverdb] {
      set l [split $serverdb($e)]
      set nl [lindex $l 0]; set nr [lindex $l 1]; set ni [lindex $l 2]
      set np [lindex $l 3]; set nx [lindex $l 4]; set nt [lindex $l 5]
      if {[lsearch -exact $u "$ni $np"] == "-1"} { continue }
      set serverdb($e) "$nl $nr $ni $np $nx $c"
    }
    server:save
  }
}


####################################################
# server:ts
####################################################
proc server:ts { t } {
  if {![string is digit $t]} { return $t }
  if {$t == 0} { return never }
  set n [clock seconds]; set t [expr $t - $n]; if {$t < 0} { set t [expr $t * -1] }
  set t [duration $t]
  set t [string map "seconds s second s minutes m minute m hours h hour h" $t]
  set t [string map "days d day d weeks w week w years y year y" $t]
  return "[join [lrange [split $t] 0 3] ""] ago"
}


####################################################
# server:save
####################################################
proc server:save { } {
  global serverdb
  set f "serverdb.txt"
  set f [open "$f" w]
  if {[file exists $f]} {
    if {![file isfile $f]} { return 0 }
    if {![file writable $f]} { return 0 }
  }
  foreach n [lsort -dictionary [array names serverdb]] { puts $f $serverdb($n) }
  close $f
  server:set
}


####################################################
# server:load
####################################################
proc server:load { } {
  global serverdb
  if {[info exists serverdb]} { unset serverdb }
  set f "serverdb.txt"
  if {![file exists $f]} { return 0 }
  if {![file isfile $f]} { return 0 }
  if {![file readable $f]} { return 0 }
  set f [open "$f" r]; set d [read $f]; close $f
  foreach l [split $d \n] {
    if {[string equal $l ""]} { continue }
    set n [string tolower [lindex [split $l] 0]]
    set serverdb($n) $l
  }
}
server:load
server:set


####################################################
# set info for script.tcl
####################################################
set ::scriptdb(server) {
  "eggdrop's native server list, 'set servers ..' in the conf is just .. limited to say the least. this script provides dcc server command to change the bot's server list on the fly entries include name (handy when the host/ip doesnt reveal this), rank (servers are tried from highest to lowest ranking, rank 0 means the entry wont be used), port, and password"
}