Untitled

#---------------------------------------------------------------------#
#                                                                     #
# Usage:                                                              #
#   .chanset #channel +wow                                            #
#   !wow [-n|-na|-e|-eu] <realm to search for>                        #
#     returns the up/down status of <realm>                           #
#     the search can be a partial match, example 'dawn' for the realm #
#     'Argent Dawn'                                                   #
#   !wow -status                                                      #
#     will display how many realms are up/total for NA & EU           #
#---------------------------------------------------------------------#
package require http 2.3
setudef flag wow

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 0

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

    # this will be used to seperate items (Realm: Foo \\ Status: Bar)
    variable seperator { - }

    # 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-1.3"
    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
      if {[regsub -nocase -- {^-(?:status)\s*} $input {} input]} {
        set using_status 1
        array set html [fetch_html "http://www.wow-europe.com/en/serverstatus/index.html" "ZZZZZZZZZZ1234567890"]
        # array set htmln [fetch_html "http://www.worldofwarcraft.com/realmstatus/compat.html" "ZZZZZZZZZZ1234567890"]
        array set htmln [fetch_html "http://www.worldofwarcraft.com/realmstatus/status.xml" "ZZZZZZZZZZ1234567890"]
      } elseif {[regsub -nocase -- {^-eu?\s*} $input {} input] || ${incith::wow::european_first} >= 1} {
        array set html [fetch_html "http://www.wow-europe.com/en/serverstatus/index.html" $input]
      } elseif {[regsub -nocase -- {^-na?\s*} $input {} input] || ${incith::wow::european_first} <= 0} {
        array set html [fetch_html "http://www.worldofwarcraft.com/realmstatus/status.xml" $input]
        # array set html [fetch_html "http://www.worldofwarcraft.com/realmstatus/compat.html" $input]
      } else {
        array set html [fetch_html "http://www.worldofwarcraft.com/realmstatus/status.xml" $input]
        # array set html [fetch_html "http://www.worldofwarcraft.com/realmstatus/compat.html" $input]
      }

      # check for html's existence
      if {[info exists html(error)] && ![info exists using_status]} {
        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::seperator}[ibold "North America:"] $na_final"
        } else {
          set reply "[ibold "North American:"] $na_final${incith::wow::seperator}[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::seperator}[ibold "Status:"] $html(realm_status)"
        } else {
          append reply "${incith::wow::seperator}[ibold "Status:"] Unavailable"
        }
        if {[info exists html(realm_population)]} {
          append reply "${incith::wow::seperator}[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} {
      # 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.00 (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
      }

      # 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><b class = \"smallBold\" style = \"color: \#......;\">(\[a-z'\ \]*${terms}\[a-z'\ \]*)</b>" $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'\ \]*${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