#---------------------------------------------------------------------#
# incith:wow                                             $Rev:: 113 $ #
# $Id:: incith-wow.tcl 113 2009-04-16 07:11:10Z incith              $ #
#                                                                     #
# checks online/offline status of World of Warcraft realms            #
# tested on Eggdrop v1.6.19 & Windrop v1.6.17                         #
#                                                                     #
# Usage:                                                              #
#   .chanset #channel +wow                                            #
#   !wow [-na|-eu] <realm to search for>                              #
#     returns the up/down status of <realm>                           #
#     searches can be a partial match, e.g. 'dawn' for 'Argent Dawn'  #
#   !wow -status                                                      #
#     will display how many realms are up/total for NA & EU           #
#                                                                     #
# ChangeLog (m/d/y):                                                  #
#   4/16/09: spaces in searches are wildcards now.                    #
#            will return a non-xml url for failed NA searches now.    #
#   1/17/09: tweaks for svn.  license changed to GPLv3.               #
#                                                                     #
# TODO:                                                               #
#   - Suggestions/Thanks/Bugs/Ideas, e-mail at bottom of header.      #
#                                                                     #
# LICENSE (GPLv3):                                                    #
#   This program is free software: you can redistribute it and/or     #
#   modify it under the terms of the GNU General Public License as    #
#   published by the Free Software Foundation, either version 3 of    #
#   the License, or (at your option) any later version.               #
#                                                                     #
#   This program is distributed in the hope that it will be useful,   #
#   but WITHOUT ANY WARRANTY; without even the implied warranty of    #
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.              #
#                                                                     #
#   See the GNU General Public License for more details.              #
#   (http://www.gnu.org/licenses/gpl-3.0.txt)                         #
#                                                                     #
# Copyright (C) 2009, Jordan                                          #
# http://incith.com ~ incith@gmail.com ~ irc.freenode.net/#incith     #
#---------------------------------------------------------------------#
package require http 2.3
setudef flag wow

# 0 (zero) will disable an optional variable, 1 or above enables
#
namespace eval incith {
  namespace eval wow {
    # the bind prefix/command char ("!" or ".", etc)
    variable command_char "!"

    # binds ("one two three")
    variable binds "wow"

    # search the european realms list primarily (will have to use -na to search north american realms)
    variable european_first 0

    # allow binds to be used in /msg's to the bot?
    variable private_messages 1

    # send replies as notices instead of private messages?
    variable notices 0

    # this will be used to separate items (Realm: Foo \\ Status: Bar)
    variable separator { \\ }

    # make use of bolding where appropriate?
    variable bold 1

    # make use of underlining for certain items? (urls mostly)
    variable underline 1

    # if you're using a proxy, enter it here (hostname.com:3128)
    variable proxy ""

    # how long (in seconds) before the http request times out?
    variable timeout 15
  }
}

# script begings
namespace eval incith {
  namespace eval wow {
    variable version "incith:wow-SVN"
    variable debug 0
  }
}

# bind the binds
foreach bind [split ${incith::wow::binds} " "] {
  # public message binds
  bind pub -|- "${incith::wow::command_char}${bind}" incith::wow::message_handler

  # private message binds
  if {${incith::wow::private_messages} >= 1} {
    bind msg -|- "${incith::wow::command_char}${bind}" incith::wow::message_handler
  }
}

namespace eval incith {
  namespace eval wow {
    # [message_handler] : handles public & private messages
    #
    proc message_handler {nick uhand hand args} {
      if {[llength $args] >= 2} { # public message
        set where [lindex $args 0]
        set input [lindex $args 1]
        if {[lsearch -exact [channel info $where] +wow] == -1} {
          return
        }
      } else {			  # private message
        if {${incith::wow::private_messages} <= 0} {
          return
        }
        set where $nick
        set input [lindex $args 0]
      }

      # no search terms given
      if {[regexp -- "^\\s*$" $input]} {
        set reply "Syntax: !wow \[-na|-eu\] <realm> or -status."
        if {${incith::wow::european_first} >= 1} {
          append reply "  Searching European realms by default."
        } else {
          append reply "  Searching North American realms by default."
        }
        send_output $where $reply
        return
      }

      # fetch the html
      set na_url {http://www.worldofwarcraft.com/realmstatus/status.xml}
      set eu_url {http://www.wow-europe.com/realmstatus/index.html?locale=en_gb}

      if {[regsub -nocase -- {\s*-(?:status)\s*} $input {} input]} {
        set using_status 1
        if {[regsub -nocase -- {\s*-na?\s*} $input {} input]} {
          array set htmln [fetch_html $na_url]
        } elseif {[regsub -nocase -- {^-eu?\s*} $input {} input]} {
          array set html [fetch_html $eu_url]
        } else {
          array set html [fetch_html $eu_url]
          array set htmln [fetch_html $na_url]
        }
      } elseif {![regsub -nocase -- {^-na?\s*} $input {} input] && ([regsub -nocase -- {^-eu?\s*} $input {} input] || ${incith::wow::european_first} >= 1)} {
        array set html [fetch_html $eu_url $input]
      } elseif {![regsub -nocase -- {^-eu?\s*} $input {} input] && ([regsub -nocase -- {^-na?\s*} $input {} input] || ${incith::wow::european_first} <= 0)} {
        array set html [fetch_html $na_url $input]
      } else {
        array set html [fetch_html $na_url $input]
      }

      # check for html's existence
      if {[info exists html(error)] && ![info exists using_status]} {
        # show a sane url for north america
        if {$html(url) == $na_url} {
          append html(error) "  Visit [iul "http://www.worldofwarcraft.com/realmstatus/"] for more information."
        } else {
          append html(error) "  Visit [iul $html(url)] for more information."
        }
        send_output $where $html(error)
        return
      }

      # make sure we have data to send, and send it
      if {[info exists using_status]} {
        if {[info exists html(eu_up)] && [info exists html(eu_down)]} {
          set eu_total [expr $html(eu_up) + $html(eu_down)]
          set eu_final "$html(eu_up)\/$eu_total"
        } else {
          set eu_final "\?\/\?"
        }
        if {[info exists htmln(na_up)] && [info exists htmln(na_down)]} {
          set na_total [expr $htmln(na_up) + $htmln(na_down)]
          set na_final "$htmln(na_up)\/$na_total"
        } else {
          set na_final "\?\/\?"
        }
        if {${incith::wow::european_first} >= 1} {
          set reply "[ibold "European:"] $eu_final${incith::wow::separator}[ibold "North America:"] $na_final"
        } else {
          set reply "[ibold "North American:"] $na_final${incith::wow::separator}[ibold "Europe:"] $eu_final"
        }
        send_output $where $reply
      } elseif {[info exists html(realm_name)]} {
        set reply "[ibold "Realm:"] $html(realm_name)"
        if {[info exists html(realm_type)]} {
          append reply " ($html(realm_type))"
        }
        if {[info exists html(realm_status)]} {
          append reply "${incith::wow::separator}[ibold "Status:"] $html(realm_status)"
        } else {
          append reply "${incith::wow::separator}[ibold "Status:"] Unavailable"
        }
        if {[info exists html(realm_population)]} {
          append reply "${incith::wow::separator}[ibold "Population:"] $html(realm_population)"
        }
        send_output $where $reply
      } else {
        send_output $where "There was a problem while attempting to parse '[iul $html(url)]'."
      }
    }

    # [send_output] : sends $data appropriately out to $where
    #
    proc send_output {where data} {
      if {${incith::wow::notices} >= 1 && ![string match {#*} $where]} {
        putquick "NOTICE $where :${data}"
      } else {
        putquick "PRIVMSG $where :${data}"
      }
    }

    # [fetch_html] : fetches and returns a list of usable data
    #
    proc fetch_html {url {terms "ZZZZZZZZZZ1234567890"}} {
      # store the website we are retrieving
      set output(url) $url

      # setup proxy information, if any
      if {[string match {*:*} ${incith::wow::proxy}] == 1} {
        set proxy_info [split ${incith::wow::proxy} ":"]
      }
      # the "browser" we are using
      set ua "Opera/9.21 (Windows NT 5.1; U; en)"

      if {[info exists proxy_info] == 1} {
        set http [::http::config -useragent $ua -proxyhost [lindex $proxy_info 0] -proxyport [lindex $proxy_info 1]]
      } else {
        set http [::http::config -useragent $ua]
      }
      # retrieve the html; round()'ed because -timeout likes integers. [catch] for error messages
      catch {set http [::http::geturl $output(url) -timeout [expr round(1000 * ${incith::wow::timeout})]]} output(status)

      # make sure the http request succeeded
      if {![string match {::http::*} $output(status)]} {
        set output(error) "Unable to connect to the server status page."
      } elseif {[::http::status $http] == "timeout"} {
        set output(error) "The operation timed out after ${incith::wow::timeout} seconds."
      } elseif {[string match {*<h1>Service Temporarily Unavailable</h1>*} [::http::data $http]]} {
        set output(error) "The service status page is currently unavailable."
      }

      # return the error if one exists, no point going further
      if {[info exists output(error)]} {
        ::http::cleanup $http
        return [array get output]
      }

      # $html will contain our html source code
      set html [::http::data $http]
      # we no longer require the connection
      ::http::cleanup $http

      # debug: output the html to a file
      if {${incith::wow::debug} >= 1} {
        set fopen [open incith-wow-pre.html w]
        puts $fopen $html
        close $fopen
      }

      # html cleanups
      regsub -all {\n} $html {} html
      regsub -all {&nbsp;} $html { } html
      regsub -all {\t} $html {} html
      regsub -all {&#039;} $html {'} html

      # debug: output the html to a file
      if {${incith::wow::debug} >= 1} {
        set fopen [open incith-wow-post.html w]
        puts $fopen $html
        close $fopen
      }

      # this makes spaces useful :/
      set search_terms $terms
      regsub -- {\s+} $search_terms {[a-z'\ ]*} search_terms

      # html parsing
      #
      # check to see if all the realms are down first
      if {[string match {*wow-europe*} $output(url)]} {
        if {![regexp -- {uparrow.gif} $html]} {
          set output(error) "All realms appear to be down."
        }
        set output(eu_up) [regexp -nocase -all -- "uparrow.gif" $html]
        set output(eu_down) [regexp -nocase -all -- "downarrow.gif" $html]
        regexp -nocase -- "(up|down)arrow.gif\" width = \"18\" height = \"18\"></td>\\s+<td class = \"serverStatus1?2?\" NOWRAP><a name=\"(\[a-z'\ \]*${search_terms}\[a-z'\ \]*)\"></a>" $html - output(realm_status) output(realm_name)
        if {[info exists output(realm_status)]} {
          set output(realm_status) [string map {u U d D} $output(realm_status)]
        }
      } else {
        if {![regexp -- {s="1"} $html]} {
          set output(error) "All realms appear to be down."
        }
        set output(na_up) [regexp -nocase -all -- {s="1"} $html]
        set output(na_down) [regexp -nocase -all -- {s="2"} $html]
        regexp -nocase -- "<r n=\"(\[a-z'\ \]*${search_terms}\[a-z'\ \]*)\" t=\"(.)\" s=\"(.)\" l=\"(.)\"/>" $html - output(realm_name) output(realm_type) output(realm_status) output(realm_population)

        # server status
        if {[info exists output(realm_status)]} {
          if {$output(realm_status) == 1} {
            set output(realm_status) "Up"
          } else {
            set output(realm_status) "Down"
          }
        }

        # population
        if {[info exists output(realm_population)]} {
          if {$output(realm_population) == 1} {
            set output(realm_population) "Low"
          } elseif {$output(realm_population) == 2} {
            set output(realm_population) "Medium"
          } elseif {$output(realm_population) == 3} {
            set output(realm_population) "High"
          } elseif {$output(realm_population) == 4} {
            set output(realm_population) "Max (Queued)"
          } else {
            unset output(realm_population)
          }
        }

        # realm type
        if {[info exists output(realm_type)]} {
          if {$output(realm_type) == 0} {
            set output(realm_type) "RPPVP"
          } elseif {$output(realm_type) == 1} {
            set output(realm_type) "Normal"
          } elseif {$output(realm_type) == 2} {
            set output(realm_type) "PVP"
          } elseif {$output(realm_type) == 3} {
            set output(realm_type) "RP"
          } else {
            unset output(realm_type)
          }
        }
      }

      # check that we have necessary data to send
      #
      if {![info exists output(error)]} {
        if {[info exists terms] && $terms != "ZZZZZZZZZZ1234567890"} {
          if {![info exists output(realm_status)]} {
            set output(error) "Sorry, I could not grab the status for the '${terms}' realm."
          }
          if {![info exists output(realm_name)]} {
            set output(error) "Sorry, I could not find the '${terms}' realm."
          }
        }
      }

      # this returns our 'output' array
      return [array get output]
    }

    # [ibold] : bolds some text, if bolding is enabled
    #
    proc ibold {input} {
      if {${incith::wow::bold} >= 1} {
        return "\002${input}\002"
      }
      return $input
    }

    # [iul] : underlines some text, if underlining is enabled
    #
    proc iul {input} {
      if {${incith::wow::underline} >= 1} {
        return "\037${input}\037"
      }
      return $input
    }
  }
}

# the script has loaded.
putlog "${incith::wow::version} loaded."

# EOF