#---------------------------------------------------------------------#
# incith:egghelp                                         $Rev:: 106 $ #
# $Id:: incith-egghelp.tcl 106 2009-01-25 20:22:14Z incith          $ #
#                                                                     #
# searches the http://www.egghelp.org Tcl archives :)                 #
# tested on Eggdrop 1.6.19 & Windrop v1.6.17                          #
#                                                                     #
# Usage:                                                              #
#   .chanset #channel +egghelp                                        #
#   !egghelp <search>                                                 #
#   !egghelp <script id> (from search)                                #
#                                                                     #
# ChangeLog (m/d/y):                                                  #
#   http://svn.incith.com/index/incith/trunk/ (view log)              #
#                                                                     #
# Thanks:                                                             #
#   Slennox, for coding a requested feature into the Tcl archive.     #
#     And for hosting the most excellent egghelp.org, of course. :)   #
#                                                                     #
# TODO:                                                               #
#   - max length variable for output, to prevent HTML floods          #
#   - 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 egghelp

# 0 (zero) will disable an optional variable, 1 or above enables
#
namespace eval incith::egghelp {
  # the bind prefix/command char(s) ({!} or {! .} etc, separate with space)
  variable command_chars {! .}

  # binds {one two three}
  variable binds {egghelp}

  # maximum number of search results to return?
  variable search_results 9

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

  # send public/channel output to the user instead?
  variable public_to_private 0

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

  # only send script 'errors' as notices? (not enough input etc)
  variable notice_errors_only 0

  # this will be used to separate items (Foo; Bar; Baz)
  variable separator {; }

  # shorten the egghelp download URLs? (must have incith-xrl.tcl installed)
  variable shorten 0

  # make use of bolding where appropriate?
  variable bold 1

  # make use of underlining where appropriate?
  variable underline 1

  # maximum length of a reply before breaking it up
  variable split_length 440

  # 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

  # use the callback function for non-blocking http fetches?
  # note: your eggdrop must be patched or else this will slow
  # lookups down a lot and even break some things.
  variable callback 0

  # if your bots participate in a botnet, you can enable this variable
  # and load the script on all of the bots, but only one bot will respond
  # to egghelp requests.  if that bot quits, the next bot in line will start.
  # there is no reason to disable this variable that I can think of.
  variable botnet 1
}

# script begings
namespace eval incith::egghelp {
  global botnet-nick nick
  if {${botnet-nick} == ""} { set botnet-nick ${nick} }
  variable version "incith:egghelp-SVN"
  variable debug 0
  array set static {}
  if {${incith::egghelp::botnet} >= 1} {
    set static(botnet,${botnet-nick},time) [clock seconds]
  } else {
    set static(botnet,${botnet-nick},time) "noswarm"
  }
  if {![info exists static(botnet,bots)]} {
    set static(botnet,bots) ${botnet-nick}
  }
}

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

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

# bind the botnet binds
if {${incith::egghelp::botnet} >= 1} {
  bind bot - incith:egghelp incith::egghelp::bot_msg
  bind link - * incith::egghelp::bot_link
  # it really depends what works better for you, checking if
  # the bot is onchan or just making sure they are linked.
  # bind disc - * incith::egghelp::bot_disc
}

namespace eval incith::egghelp {
  proc bot_msg {from cmd text} {
    global botnet-nick
    upvar #0 incith::egghelp::static static
    if {${incith::egghelp::debug} >= 1} {
      putlog "${incith::egghelp::version} (botmsg): <${from}> ${cmd} ${text}"
    }

    # receiving a bots load time
    if {[string match "time ?*" $text]} {
      regexp -- {time (.*)} $text - time
      set static(botnet,${from},time) $time
      # make sure this bot is in our bot list
      if {![string match "*${from}*" $static(botnet,bots)]} {
        putlog "${incith::egghelp::version} (botnet): ${from} has joined the incith:egghelp swarm."
        append static(botnet,bots) ";${from}"
        regsub -all -- {;;} $static(botnet,bots) {;} static(botnet,bots)
        set static(botnet,bots) [string trimright $static(botnet,bots) {;}]
      }
    }
  }

  proc bot_link {bot hub} {
    global botnet-nick
    upvar #0 incith::egghelp::static static
    # send our time to the bots
    putallbots "incith:egghelp time $static(botnet,${botnet-nick},time)"
  }

  proc bot_disc {bot} {
    global botnet-nick
    upvar #0 incith::egghelp::static static
    if {[string match "*${bot}*" $static(botnet,bots)]} {
      if {$static(botnet,${bot},time) != "noswarm"} {
        putlog "${incith::egghelp::version} (botnet): ${bot} has left the incith:egghelp swarm."
      }
    }
    # remove this bot from our bot list
    regsub -all -- $bot $static(botnet,bots) {} static(botnet,bots)
    regsub -all -- {;;} $static(botnet,bots) {;} static(botnet,bots)
    set static(botnet,bots) [string trimright $static(botnet,bots) {;}]
    # remove their time?  If they just lost link, they might still be [onchan]
    # unset static(botnet,${bot},time)
  }
}


namespace eval incith::egghelp {
  # [message_handler] : handles public & private messages
  #
  proc message_handler {nick uhand hand args} {
    global botnet-nick lastbind
    upvar #0 incith::egghelp::static static
    set input(who) $nick
    if {[llength $args] >= 2} { # public message
      set input(where) [lindex $args 0]
      if {${incith::egghelp::public_to_private} >= 1} {
        set input(chan) $input(who)
      } else {
        set input(chan) $input(where)
      }
      set input(query) [lindex $args 1]
      if {[channel get $input(where) egghelp] != 1} {
        return
      }
    } else {                    # private message
      set input(where) "private"
      set input(chan) $input(who)
      set input(query) [lindex $args 0]
      if {${incith::egghelp::private_messages} <= 0} {
        return
      }
    }

    # botnet
    if {${incith::egghelp::botnet} >= 1 && $input(where) != "private"} {
      foreach bot [split $static(botnet,bots) ";"] {
        # skip ourselves, bots not on the input channel, and bots not participating
        if {${bot} == ${botnet-nick} || ![onchan ${bot} $input(where)] || $static(botnet,${bot},time) == "noswarm"} {
          continue
        # bots that load first will serve first.  change < to > to reverse.
        } elseif {$static(botnet,$bot,time) < $static(botnet,${botnet-nick},time)} {
          if {${incith::egghelp::debug} >= 1} {
            putlog "${incith::egghelp::version} (botnet): $bot loaded before me."
          }
          return
        # should 2 bots have the same time, set a new random time (this did happen in testing)
        } elseif {$static(botnet,${bot},time) == $static(botnet,${botnet-nick},time)} {
          if {${incith::egghelp::debug} >= 1} {
            putlog "${incith::egghelp::version} (botnet): $bot had the same load time as me!"
          }
          set static(botnet,${botnet-nick},time) [expr [clock seconds] + int(rand()*60)+1]
          putallbots "incith:egghelp time $static(botnet,${botnet-nick},time)"
          return
        }
      }
      # looks like we're serving, make sure we keep the botnet up to date
      putallbots "incith:egghelp time $static(botnet,${botnet-nick},time)"
    }
    set input(query) [string trim $input(query)]

    # log it
    if {[regexp -- {^\s*$} $input(query)]} {
      ipl "<${input(who)}/${input(where)}>"
      send_output $input(chan) "Syntax: ${lastbind} <search>, ${lastbind} <id#>, ${lastbind} \[-top|-new\]"
      return
    } else {
      ipl ${input(who)} ${input(where)} "${lastbind} ${input(query)}"
    }

    # do some things:
    regsub -all -- {[~`!@#$%^&*()/;\\\?:':]} $input(query) {} input(query)
    regsub -all -- {\s+} $input(query) {+} input(query)

    # fetch the html
    if {[regexp -- {^\d+$} $input(query)]} {
      set input(search_mode) "single"
      set input(url) "http://www.egghelp.org/cgi-bin/tcl_archive.tcl?fields=scriptid&strings=${input(query)}"
    } elseif {[regsub -nocase -all -- {\-top} $input(query) {} input(query)]} {
      set input(search_mode) "top"
      set input(url) "http://www.egghelp.org/cgi-bin/tcl_archive.tcl?sort=9"
    } elseif {[regsub -nocase -all -- {\-new} $input(query) {} input(query)]} {
      set input(search_mode) "new"
      set input(url) "http://www.egghelp.org/cgi-bin/tcl_archive.tcl?added=31"
    } else {
      set input(search_mode) "default"
      set input(url) "http://www.egghelp.org/cgi-bin/tcl_archive.tcl?strings=${input(query)}"
    }
    fetch_html [array get input]
  }


  # [fetch_html] : fetch html of a given url
  #
  proc fetch_html {tmpInput} {
    upvar #0 incith::egghelp::static static
    array set input $tmpInput

    # setup the timeout, for use below
    set timeout [expr round(1000 * ${incith::egghelp::timeout})]
    # setup proxy information, if any
    if {[string match {*:*} ${incith::egghelp::proxy}] == 1} {
      set proxy_info [split ${incith::egghelp::proxy} ":"]
    }
    # the "browser" we are using
    # NT 5.1 - XP, NT 6.0 - Vista
    set ua "Opera/9.63 (Windows NT 6.0; U; en)"
    if {[info exists proxy_info] == 1} {
      ::http::config -useragent $ua -proxyhost [lindex $proxy_info 0] -proxyport [lindex $proxy_info 1]
    } else {
      ::http::config -useragent $ua
    }
    # retrieve the html
    if {$incith::egghelp::callback >= 1} {
      catch {set token [::http::geturl "${input(url)}" -command incith::egghelp::httpCommand -timeout $timeout]} output(status)
    } else {
      catch {set token [::http::geturl "${input(url)}" -timeout $timeout]} output(status)
    }
    # need to check for some errors here:
    if {[string match "couldn't open socket: host is unreachable*" $output(status)]} {
      send_output $input(chan) "Unknown host '${input(query)}'." $input(who)
      return
    } elseif {[string match "Missing host part:*" $output(status)]} {
      send_output $input(chan) "Invalid host '${input(query)}'." $input(who)
      return
    } elseif {[string match "Unsupported URL type*" $output(status)]} {
      send_output $input(chan) "Unsupported URL type '${input(query)}'." $input(who)
      return
    } elseif {![string match "::http::*" $output(status)]} {
      send_output $input(chan) "Unknown Error: $output(status)" $input(who)
      return
    }
    # no errors, move on:
    set static($token,input) [array get input]
    # manually call our callback procedure if we're not using callbacks
    if {$incith::egghelp::callback <= 0} {
      httpCommand $token
    }
  }


  # [httpCommand] : makes sure the http request succeeded
  #
  proc httpCommand {token} {
    upvar #0 $token state
    upvar #0 incith::egghelp::static static
    # build the output array
    array set output $static($token,input)

    switch -exact [::http::status $token] {
      "timeout" {
        if {$incith::egghelp::debug >= 1} {
          ipl $output(who) $output(where) "status = timeout (url = $state(url))"
        }
        set output(error) "Operation timed out after ${incith::egghelp::timeout} seconds."
      }
      "error" {
        if {$incith::egghelp::debug >= 1} {
          ipl $output(who) $output(where) "status = error([::http::error $token]) (url = $state(url))"
        }
        set output(error) "An unknown error occurred. (Error #01)"
      }
      "ok" {
        switch -glob [::http::ncode $token] {
          3* {
            array set meta $state(meta)
            if {$incith::egghelp::debug >= 1} {
              ipl $output(who) $output(where) "redirecting to $meta(Location)"
            }
            set output(url) $meta(Location)
            fetch_html [array get output]
            return
          }
          200 {
            if {$incith::egghelp::debug >= 1} {
              ipl $output(who) $output(where) "parsing $state(url)"
            }
          }
          default {
            if {$incith::egghelp::debug >= 1} {
              ipl $output(who) $output(where) "status = default, error"
            }
            set output(error) "An unknown error occurred. (Error #02)"
          }
        }
      }
      default {
        if {$incith::egghelp::debug >= 1} {
          ipl $output(who) $output(where) "status = unknown, default, error"
        }
        set output(error) "An unknown error occurred. (Error #03)"
      }
    }
    set static($token,output) [array get output]
    process_html $token
  }


  # [process_html] :
  #
  proc process_html {token} {
    upvar #0 $token state
    upvar #0 incith::egghelp::static static
    array set output $static($token,output)

    # get the html
    set html $state(body)

    # html cleanups
    regsub -all {\n} $html {} html
    regsub -all {\t} $html {} html
    regsub -all {&nbsp;} $html { } html
    regsub -all {&gt;} $html {>} html
    regsub -all {&lt;} $html {<} html
    regsub -all {&amp;} $html {\&} html
    regsub -all {(?:<b>|</b>)} $html {} html
    # search keywords, for optional bolding
    regsub -all -- {<strong class="highlight">(.+?)</strong>} $html {<b>\1</b>} html
    # 2+ spaces become 1
    regsub -all -- {\s{2,}} $html {} html

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

    # html parsing
    #
    # fetch the title of the website, and store it into the output array
    regexp -nocase -- {<br>Found (\d+) matche?s?} $html - output(matches)
    if {![info exists output(matches)]} {
      set output(matches) 0
    }
    if {$output(search_mode) == "new"} {
      regexp -nocase -- {(<th align="left" colspan="6">.*?<th align="left" colspan="6">)} $html - html
      regexp -nocase -- {<th align="left" colspan="6">Added\s*(.+?)</td>.+?} $html - output(new_updated)
    }
    set results 0 ; set output(reply) ""
    set ehre0 {<tr><td>(<a href="/cgi-bin/.+?</td>.+?</td>.+?</td>)}
    set ehre0_single {<tr><td>(<a href="/cgi-bin/.+?</td>.+?</td>.+?</td>.+?</td>.+?</td>)}
    set ehre_single {<a href="/cgi-bin/tcl_archive\.tcl\?mode=download\&id=(\d+)" title="(.+?) download.+?">(.+?)</a></td><td>(.+?)</td><td>(.+?)</td><td>(.+?)</td><td>(.+?)</td>}
    set ehre2 {<a href="/cgi-bin/tcl_archive\.tcl\?mode=download\&id=(\d+)" title="(.+?) download.+?">(.+?)</a></td><td>(.+?)</td><td>(.+?)</td>}

    # single search result or searching by id number
    if {$output(search_mode) == "single" || $output(matches) == "1"} {
      regexp -- $ehre0_single $html - alink
      if {[info exists alink]} {
        regsub -- {<br><font size="1">.+?</font>} $alink {} alink
        regexp -- $ehre_single $alink - id downloads name script_version script_date script_author script_description
        if {[info exists id] && [info exists downloads] && [info exists name] && [info exists script_version] && [info exists script_date] && [info exists script_author] && [info exists script_description]} {
          if {$script_version == "-"} { set script_version "?" }
          if {$script_date == "-"} { set script_date "?/?/?" }
          if {![string match -nocase "r*" $script_version] && ![string match -nocase "v*" $script_version]} {
            set script_version "v${script_version}"
          }
          append output(reply) "[ibold "\#${id}"]: ${name} ${script_version} (${script_date}, ${downloads} DLs) by ${script_author}: ${script_description}"
          if {${incith::egghelp::shorten} >= 1 && [namespace exist ::incith::xrl]} {
            append output(reply) " (Download: [iul [incith::xrl::shorten "http://www.egghelp.org/cgi-bin/tcl_archive.tcl?mode=download&id=${id}" $output(chan)]])"
          } else {
            append output(reply) " ([iul "http://www.egghelp.org/cgi-bin/tcl_archive.tcl?mode=download&id=${id}"])"
          }
        }
      }
    } else {
    # multiple search results
      while {$results < ${incith::egghelp::search_results}} {
        regexp -- $ehre0 $html - alink
        if {[info exists alink]} {
          regsub -all -- {<br><font size="1">.+?</font>} $alink {} alink
          regexp -- $ehre2 $alink - id downloads name script_version script_date
          if {[info exists id] && [info exists downloads] && [info exists name] && [info exists script_version] && [info exists script_date]} {
            regsub -- $ehre0 $html {} html
            if {$script_version == "-"} { set script_version "?" }
            if {$script_date == "-"} { set script_date "?/?/?" }
            if {![string match -nocase "r*" $script_version] && ![string match -nocase "v*" $script_version]} {
              set script_version "v${script_version}"
            }
            if {$output(search_mode) == "new"} {
              append output(reply) "[ibold "\#${id}"]: ${name} ${script_version} (${script_date})${incith::egghelp::separator}"
            } else {
              append output(reply) "[ibold "\#${id}"]: ${name} ${script_version} (${downloads} DLs)${incith::egghelp::separator}"
            }
            unset id; unset downloads; unset name; unset script_version; unset alink
          }
        }
        incr results
      }
    }

    # store the HTML to a file
    if {$incith::egghelp::debug >= 1} {
      set fopen [open incith-egghelp-post.html w]
      foreach line [line_wrap $html] {
        puts $fopen $line
      }
      close $fopen
    }
    if {$output(reply) != ""} {
       set output(reply) [string trimright $output(reply) $incith::egghelp::separator]
       if {$output(search_mode) == "new" && [info exists output(new_updated)]} {
         set output(reply) "Updated ${output(new_updated)}: $output(reply)"
       }
    }
    if {[string length $output(reply)] >= 1000} { set output(error) "Reply was too long, parsing likely failed." }
    if {${incith::egghelp::bold} >= 1} {
      regsub -all -- {(?:<b>|</b>)} $output(reply) "\002" output(reply)
    } else {
      regsub -all -- {(?:<b>|</b>)} $output(reply) {} output(reply)
    }

    # check for errors
    if {$output(matches) == "0" && ![info exists output(error)]} {
      set output(error) "No results found."
    }

    # process the output array
    set static($token,output) [array get output]
    process_output $token
  }


  # [process_output] : create the output and send it
  #
  proc process_output {token} {
    upvar #0 $token state
    upvar #0 incith::egghelp::static static
    array set output $static($token,output)

    # check for errors
    if {[info exists output(error)]} {
      send_output $output(chan) $output(error) $output(who)
      return
    }

    # send the result
    send_output $output(chan) "$output(reply)"

    # clean the static array for this http session
    foreach value [array get static] {
      if {[info exists static($value)]} {
        if {[string match *${token}* $value]} {
          unset static($value)
        }
      }
    }
  }


  # [ipl] : a neat/handy putlog procedure
  #
  proc ipl {who {where {}} {what {}}} {
    if {$where == "" && $what == ""} {
      # first argument only = data only
      foreach line [incith::egghelp::line_wrap $who] {
        putlog "${incith::egghelp::version}: ${line}"
      }
    } elseif {$where != "" && $what == ""} {
      # two arguments = who and data
      foreach line [incith::egghelp::line_wrap $where] {
        putlog "${incith::egghelp::version}: <${who}> ${line}"
      }
    } else {
      # all three...
      foreach line [incith::egghelp::line_wrap $what] {
        putlog "${incith::egghelp::version}: <${who}/${where}> ${line}"
      }
    }
  }


  # [send_output] : sends $data appropriately out to $where
  #
  proc send_output {where data {isErrorNick {}}} {
    if {${incith::egghelp::notices} >= 1} {
      foreach line [incith::egghelp::line_wrap $data] {
        putquick "NOTICE $where :${line}"
      }
    } elseif {${incith::egghelp::notice_errors_only} >= 1 && $isErrorNick != ""} {
      foreach line [incith::egghelp::line_wrap $data] {
        putquick "NOTICE $isErrorNick :${line}"
      }
    } else {
      foreach line [incith::egghelp::line_wrap $data] {
        putquick "PRIVMSG $where :${line}"
      }
    }
  }


  # [line_wrap] : takes a long line in, and chops it before the specified length
  # http://forum.egghelp.org/viewtopic.php?t=6690
  #
  proc line_wrap {str {splitChr { }}} {
    set out [set cur {}]
    set i 0
    set len $incith::egghelp::split_length
    foreach word [split [set str][set str ""] $splitChr] {
      if {[incr i [string len $word]] > $len} {
        lappend out [join $cur $splitChr]
        set cur [list $word]
        set i [string len $word]
      } else {
        lappend cur $word
      }
      incr i
    }
    lappend out [join $cur $splitChr]
  }


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


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

# the script has loaded.
namespace eval incith::egghelp {
  putallbots "incith:egghelp time $static(botnet,${botnet-nick},time)"
}
incith::egghelp::ipl "loaded."

# EOF