####################
##  Http Package  ##
####################
putlog "+++ Loading Http Package"

package require Tcl 8.2
package provide http 2.5.001

namespace eval http {
  variable http
  array set http {
    -accept       */*
    -proxyhost    {}
    -proxyport    {}
    -proxyfilter  http::ProxyRequired
  }
  set http(-useragent) {Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7) Gecko/20040803 Firefox/0.9.3}
  proc init {} {
    variable formMap
    variable alphanumeric a-zA-Z0-9
    for {set i 0} {$i <= 256} {incr i} {
      set c [format %c $i]
      if {![string match \[$alphanumeric\] $c]} {
        set formMap($c) %[format %.2x $i]
      }
    }
    array set formMap { " " + \n %0d%0a }
  }
  init

  variable urlTypes
  array set urlTypes {
    http          {80 ::socket}
  }

  variable encodings [string tolower [encoding names]]
  variable defaultCharset "iso8859-1"

  namespace export geturl config reset wait formatQuery register unregister
}

proc http::register {proto port command} {
  variable urlTypes
  set urlTypes($proto) [list $port $command]
}

proc http::unregister {proto} {
  variable urlTypes
  if {![info exists urlTypes($proto)]} {
    return -code error "unsupported url type \"$proto\""
  }
  set old $urlTypes($proto)
  unset urlTypes($proto)
  return $old
}

proc http::config {args} {
  variable http
  set options [lsort [array names http -*]]
  set usage [join $options ", "]
  if {[llength $args] == 0} {
    set result {}
    foreach name $options {
      lappend result $name $http($name)
    }
    return $result
  }
  set options [string map {- ""} $options]
  set pat ^-([join $options |])$
  if {[llength $args] == 1} {
    set flag [lindex $args 0]
    if {[regexp -- $pat $flag]} {
      return $http($flag)
    } else {
      return -code error "Unknown option $flag, must be: $usage"
    }
  } else {
    foreach {flag value} $args {
      if {[regexp -- $pat $flag]} {
        set http($flag) $value
      } else {
        return -code error "Unknown option $flag, must be: $usage"
      }
    }
  }
}

proc http::Finish { token {errormsg ""} {skipCB 0}} {
  variable $token
  upvar 0 $token state
  global errorInfo errorCode
  if {[string length $errormsg] != 0} {
    set state(error) [list $errormsg $errorInfo $errorCode]
    set state(status) error
  }
  catch {close $state(sock)}
  catch {after cancel $state(after)}
  if {[info exists state(-command)] && !$skipCB} {
    if {[catch {eval $state(-command) {$token}} err]} {
      if {[string length $errormsg] == 0} {
        set state(error) [list $err $errorInfo $errorCode]
        set state(status) error
      }
    }
    if {[info exists state(-command)]} {
      unset state(-command)
    }
  }
}

proc http::reset { token {why reset} } {
  variable $token
  upvar 0 $token state
  set state(status) $why
  catch {fileevent $state(sock) readable {}}
  catch {fileevent $state(sock) writable {}}
  Finish $token
  if {[info exists state(error)]} {
    set errorlist $state(error)
    unset state
    eval ::error $errorlist
  }
}

proc http::base64 {arguments} {
  set base64_en "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 + /"
  set wrapchar "\n"
  set maxlen 60
  set result {}
  set state 0
  set length 0
  if {[llength $arguments] == 0} {
   error "wrong # args: should be \"[lindex [info level 0] 0] string\""
  }
  binary scan $arguments c* X
  foreach {x y z} $X {
    if {$maxlen && $length >= $maxlen} {
      append result $wrapchar
      set length 0
    }
    append result [lindex $base64_en [expr {($x >> 2) & 0x3F}]]
    if {$y != {}} {
      append result [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]]
      if {$z != {}} {
        append result [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
        append result [lindex $base64_en [expr {($z & 0x3F)}]]
      } else {
        set state 2
        break
      }
    } else {
      set state 1
      break
    }
    incr length 4
  }
  if {$state == 1} {
    append result [lindex $base64_en [expr {(($x << 4) & 0x30)}]]==
  } elseif {$state == 2} {
    append result [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]=
  }
  return $result
}

proc http::geturl { url args } {
  variable http
  variable urlTypes
  variable defaultCharset

  if {![info exists http(uid)]} {
    set http(uid) 0
  }
  set token [namespace current]::[incr http(uid)]
  variable $token
  upvar 0 $token state
  reset $token

  array set state {
    -binary          false
    -blocksize       8192
    -queryblocksize  8192
    -validate        0
    -headers         {}
    -timeout         0
    -type            application/x-www-form-urlencoded
    -queryprogress   {}
    state            header
    meta             {}
    coding           {}
    currentsize      0
    totalsize        0
    querylength      0
    queryoffset      0
    type             text/html
    body             {}
    status           ""
    http             ""
  }

  array set type {
    -binary          boolean
    -blocksize       integer
    -queryblocksize  integer
    -validate        boolean
    -timeout         integer
  }
  set state(charset)      $defaultCharset
  set options {-binary -blocksize -channel -command -handler -headers \
               -progress -query -queryblocksize -querychannel -queryprogress\
               -validate -timeout -type}
  set usage [join $options ", "]
  set options [string map {- ""} $options]
  set pat ^-([join $options |])$
  foreach {flag value} $args {
    if {[regexp $pat $flag]} {
     if {[info exists type($flag)] && ![string is $type($flag) -strict $value]} {
        unset $token
        return -code error "Bad value for $flag ($value), must be $type($flag)"
      }
      set state($flag) $value
    } else {
      unset $token
      return -code error "Unknown option $flag, can be: $usage"
    }
  }

  set isQueryChannel [info exists state(-querychannel)]
  set isQuery [info exists state(-query)]
  if {$isQuery && $isQueryChannel} {
    unset $token
    return -code error "Can't combine -query and -querychannel options!"
  }

  set exp {^(([^:]*)://)?(([^@]+?)@)?([^/:]+?)(:([0-9]+?))?(/.*)?$}
  if {![regexp -nocase $exp $url x prefix proto y user host z port srvurl]} {
    unset $token
    return -code error "Unsupported URL: $url"
  }
  if {[string length $proto] == 0} {
    set proto http
    set url ${proto}://$url
  }
  if {![info exists urlTypes($proto)]} {
    unset $token
    return -code error "Unsupported URL type \"$proto\""
  }
  set defport [lindex $urlTypes($proto) 0]
  set defcmd [lindex $urlTypes($proto) 1]
  if {[string length $port] == 0} {
    set port $defport
  }
  if {[string length $srvurl] == 0} {
    set srvurl /
  }
  if {[string length $proto] == 0} {
    set url http://$url
  }
  set state(url) $url
  if {![catch {$http(-proxyfilter) $host} proxy]} {
    set phost [lindex $proxy 0]
    set pport [lindex $proxy 1]
  }

  if {$state(-timeout) > 0} {
    set state(after) [after $state(-timeout) \
    [list http::reset $token timeout]]
    set async -async
  } else {
    set async ""
  }

  if {[info exists phost] && [string length $phost]} {
    set srvurl $url
    set conStat [catch {eval $defcmd $async {$phost $pport}} s]
  } else {
    set conStat [catch {eval $defcmd $async {$host $port}} s]
  }
  if {$conStat} {
    Finish $token "" 1
    cleanup $token
    return -code error $s
  }
  set state(sock) $s

  if {$state(-timeout) > 0} {
    fileevent $s writable [list http::Connect $token]
    http::wait $token
    if {[string equal $state(status) "error"]} {
      set err [lindex $state(error) 0]
      cleanup $token
      return -code error $err
    } elseif {![string equal $state(status) "connect"]} {
      return $token
    }
    set state(status) ""
  }

  fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)

  catch {fconfigure $s -blocking off}
  set how GET
  if {$isQuery} {
    set state(querylength) [string length $state(-query)]
    if {$state(querylength) > 0} {
      set how POST
      set contDone 0
    } else {
      unset state(-query)
      set isQuery 0
    }
  } elseif {$state(-validate)} {
    set how HEAD
  } elseif {$isQueryChannel} {
    set how POST
    fconfigure $state(-querychannel) -blocking 1 -translation binary
    set contDone 0
  }
  if {[catch {
    puts $s "$how $srvurl HTTP/1.0"
    puts $s "Accept: $http(-accept)"
    if {$port == $defport} {
      puts $s "Host: $host"
    } else {
      puts $s "Host: $host:$port"
    }
    puts $s "User-Agent: $http(-useragent)"
    if {[string length $user] >= 1} {
      set b64user [base64 $user]
      puts $s "Authorization: Basic $b64user"
    }
    foreach {key value} $state(-headers) {
      set value [string map [list \n "" \r ""] $value]
      set key [string trim $key]
      if {[string equal $key "Content-Length"]} {
        set contDone 1
        set state(querylength) $value
      }
      if {[string length $key]} {
        puts $s "$key: $value"
      }
    }
    if {$isQueryChannel && $state(querylength) == 0} {
      set start [tell $state(-querychannel)]
      seek $state(-querychannel) 0 end
      set state(querylength) [expr {[tell $state(-querychannel)] - $start}]
      seek $state(-querychannel) $start
    }

    if {$isQuery || $isQueryChannel} {
      puts $s "Content-Type: $state(-type)"
      if {!$contDone} {
        puts $s "Content-Length: $state(querylength)"
      }
      puts $s ""
      fconfigure $s -translation {auto binary}
      fileevent $s writable [list http::Write $token]
    } else {
      puts $s ""
      flush $s
      fileevent $s readable [list http::Event $token]
    }
    if {! [info exists state(-command)]} {
      wait $token
      if {[string equal $state(status) "error"]} {
        return -code error [lindex $state(error) 0]
      }
    }
  } err]} {
    if {[string equal $state(status) "error"]} {
      Finish $token $err 1
    }
    cleanup $token
    return -code error $err
  }
  return $token
}

proc http::data {token} {
  variable $token
  upvar 0 $token state
  return $state(body)
}
proc http::status {token} {
  variable $token
  upvar 0 $token state
  return $state(status)
}
proc http::code {token} {
  variable $token
  upvar 0 $token state
  return $state(http)
}
proc http::ncode {token} {
  variable $token
  upvar 0 $token state
  if {[regexp {[0-9]{3}} $state(http) numeric_code]} {
    return $numeric_code
  } else {
    return $state(http)
  }
}
proc http::size {token} {
  variable $token
  upvar 0 $token state
  return $state(currentsize)
}

proc http::error {token} {
  variable $token
  upvar 0 $token state
  if {[info exists state(error)]} {
    return $state(error)
  }
  return ""
}

proc http::cleanup {token} {
  variable $token
  upvar 0 $token state
  if {[info exists state]} {
    unset state
  }
}

proc http::Connect {token} {
  variable $token
  upvar 0 $token state
  global errorInfo errorCode
  if {[eof $state(sock)] || [string length [fconfigure $state(sock) -error]]} {
    Finish $token "connect failed [fconfigure $state(sock) -error]" 1
  } else {
    set state(status) connect
    fileevent $state(sock) writable {}
  }
  return
}

proc http::Write {token} {
  variable $token
  upvar 0 $token state
  set s $state(sock)

  set done 0
  if {[catch {
    if {[info exists state(-query)]} {
      puts -nonewline $s \
        [string range $state(-query) $state(queryoffset) \
        [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
      incr state(queryoffset) $state(-queryblocksize)
      if {$state(queryoffset) >= $state(querylength)} {
        set state(queryoffset) $state(querylength)
        set done 1
      }
   } else {
      set outStr [read $state(-querychannel) $state(-queryblocksize)]
      puts -nonewline $s $outStr
      incr state(queryoffset) [string length $outStr]
      if {[eof $state(-querychannel)]} {
        set done 1
      }
    }
  } err]} {
    set state(posterror) $err
    set done 1
  }
  if {$done} {
    catch {flush $s}
    fileevent $s writable {}
    fileevent $s readable [list http::Event $token]
  }

  if {[string length $state(-queryprogress)]} {
    eval $state(-queryprogress) [list $token $state(querylength) $state(queryoffset)]
  }
}

proc http::Event {token} {
  variable $token
  upvar 0 $token state
  set s $state(sock)
  if {[eof $s]} {
    Eof $token
    return
  }
  if {[string equal $state(state) "header"]} {
    if {[catch {gets $s line} n]} {
      Finish $token $n
    } elseif {$n == 0} {
      variable encodings
      set state(state) body
      if {$state(-binary) || ![string match -nocase text* $state(type)] || [string match *gzip* $state(coding)] || [string match *compress* $state(coding)]} {
        fconfigure $s -translation binary
        if {[info exists state(-channel)]} {
          fconfigure $state(-channel) -translation binary
        }
      } else {
        set idx [lsearch -exact $encodings [string tolower $state(charset)]]
        if {$idx >= 0} {
          fconfigure $s -encoding [lindex $encodings $idx]
        }
      }
      if {[info exists state(-channel)] && ![info exists state(-handler)]} {
        fileevent $s readable {}
        CopyStart $s $token
      }
    } elseif {$n > 0} {
      if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
        set state(type) [string trim $type]
        regexp -nocase {charset\s*=\s*(\S+)} $type x state(charset)
      }
      if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
        set state(totalsize) [string trim $length]
      }
      if {[regexp -nocase {^content-encoding:(.+)$} $line x coding]} {
        set state(coding) [string trim $coding]
      }
      if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
        lappend state(meta) $key [string trim $value]
      } elseif {[string match HTTP* $line]} {
        set state(http) $line
      }
    }
  } else {
    if {[catch {
      if {[info exists state(-handler)]} {
        set n [eval $state(-handler) {$s $token}]
      } else {
        set block [read $s $state(-blocksize)]
        set n [string length $block]
        if {$n >= 0} {
          append state(body) $block
        }
      }
      if {$n >= 0} {
        incr state(currentsize) $n
      }
    } err]} {
      Finish $token $err
    } else {
      if {[info exists state(-progress)]} {
        eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
      }
    }
  }
}

proc http::CopyStart {s token} {
    variable $token
    upvar 0 $token state
    if {[catch {
      fcopy $s $state(-channel) -size $state(-blocksize) -command \
          [list http::CopyDone $token]
    } err]} {
      Finish $token $err
    }
}

proc http::CopyDone {token count {error {}}} {
  variable $token
  upvar 0 $token state
  set s $state(sock)
  incr state(currentsize) $count
  if {[info exists state(-progress)]} {
    eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
  }
  if {[string length $error]} {
    Finish $token $error
  } elseif {[catch {eof $s} iseof] || $iseof} {
    Eof $token
  } else {
    CopyStart $s $token
  }
}

proc http::Eof {token} {
  variable $token
  upvar 0 $token state
  if {[string equal $state(state) "header"]} {
    # Premature eof
    set state(status) eof
  } else {
    set state(status) ok
  }
  set state(state) eof
  Finish $token
}

proc http::wait {token} {
  variable $token
  upvar 0 $token state

  if {![info exists state(status)] || [string length $state(status)] == 0} {
    # We must wait on the original variable name, not the upvar alias
    vwait $token\(status)
  }

  return $state(status)
}

proc http::formatQuery {args} {
  set result ""
  set sep ""
  foreach i $args {
    append result $sep [mapReply $i]
    if {[string equal $sep "="]} {
      set sep &
    } else {
      set sep =
    }
  }
  return $result
}

proc http::mapReply {string} {
  variable formMap
  variable alphanumeric

  regsub -all \[^$alphanumeric\] $string {$formMap(&)} string
  regsub -all {[][{})\\]\)} $string {\\&} string
  return [subst -nocommand $string]
}

proc http::ProxyRequired {host} {
  variable http
  if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
    if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {
      set http(-proxyport) 8080
    }
    return [list $http(-proxyhost) $http(-proxyport)]
  }
}

putlog "+++ Http Package Loaded"


##############
##  Google  ##
##############
set google(triggers) "!google"
set google(antiflood) 5
set google(method) 1
set google(results) 6
set google(perline) 0

if {[catch { package require http } err]} {
  putlog "Cannot load [file tail [info script]]: Problem loading the http package: $err"
  return 1
}

if {[info tclversion] < 8.1} {
  putlog "Cannot load [file tail [info script]]: You need at least Tcl version 8.1 and you have Tcl version [info tclversion]."
  return 1
}

foreach trigger [split $google(triggers)] {
  bind pub - $trigger google:pub
}
catch { unset trigger }

proc google:output {chan nick output} {
  global google
  switch $google(method) {
    0 { putquick "PRIVMSG $nick :$output" }
    1 { putquick "PRIVMSG $chan :$output" }
    2 { putquick "NOTICE $nick :$output" }
    3 { putquick "NOTICE $chan :$output" }
    default { putquick "PRIVMSG $chan :$output" }
  }
}

proc google:pub {nick uhost hand chan text} {
  global lastbind google

  if {[string length [string trim [lindex $text 0]]] == 0} {
    putquick "PRIVMSG $chan :Aturan pakai : !google <kata kunci>"
    return 0
  }

  if {[info exists google(floodprot)]} {
    set diff [expr [clock seconds] - $google(floodprot)]
    if {$diff < $google(antiflood)} {
      putquick "PRIVMSG $chan :$nick, Sabar donk ah..! Tunggu [expr $google(antiflood) - $diff] detik lagi"
      return 0
    }
    catch { unset diff }
  }
  set google(floodprot) [clock seconds]

  regsub -all { } [join $text] {+} search
  set google(url) "http://www.google.nl/search?q=$search"
  set google(page) [http::config -useragent "Mozilla"]
  if {[catch {set google(page) [http::geturl $google(url) -timeout 15000]} msg]} {
    putquick "NOTICE $nick :Can't connect ($msg)"
    return 0
  }
  set google(data) [http::data $google(page)]

  if {$google(results) >= 1} {
    regexp -nocase {related:(.*?)>} $google(data) t link1
  }
  if {$google(results) >= 2} {
    regexp -nocase {related:.*?>.*?related:(.*?)>} $google(data) t link2
  }
  if {$google(results) >= 3} {
    regexp -nocase {related:.*?>.*?related:(.*?)>} $google(data) t link3
  }
  if {$google(results) >= 4} {
    regexp -nocase {related:.*?>.*?related:(.*?)>} $google(data) t link4
  }
  if {$google(results) >= 5} {
    regexp -nocase {related:.*?>.*?related:(.*?)>} $google(data) t link5
  }
  if {$google(results) >= 6} {
    regexp -nocase {related:.*?>.*?related:.*?>.*?related:(.*?)>} $google(data) t link6
  }

  if {$google(perline) == 1} {
    set separator "\n"
  } else {
    set separator "-"
  }

  if {[info exists link6]} {
    set output "7http://$link1 $separator 7http://$link2 $separator 7http://$link6"
  } elseif {[info exists link2]} {
    set output "7http://$link1 $separator 7http://$link2"
  } elseif {[info exists link1]} {
    set output "7http://$link1"
  } else {
    set output "Ogah ah.. Capek disuruh mlulu"
  }

  regsub -all {%26} $output {\&} output
  regsub -all {%3F} $output {?} output
  regsub -all {%3D} $output {=} output 

  if {$google(perline) == 1} {
    foreach line [split $output \n] {
      google:output $chan $nick [string trim $line]
    }
  } else { 
    google:output $chan $nick [string trim $output]
  }

  catch { unset output separator t link1 link2 link3 link4 link5 link6}
  catch { http::cleanup $google(page) }

  return 0
}

putlog "+++ Google Search TCL Loaded"