#
# rae.tcl 1.0.1 --
# This script for eggdrop gets the mp3 path file from a goear.com link
# It also creates a tinyurl to download it
#
# Copyright (c) 2007-2009 Eggdrop Spain 28-april-2009
#   HackeMate (Sentencia) Sentencia@eggdrop.es
#
# This program is free software; you can redistribute it and/or
# modify it _only for your own use_
#
# 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.  
#
# Please, use the email to contact with the author for let him know about all
# what you could do. Everyone wants develop his software as well.
#
#                   Thank you for feed my empiric life.
#
# If you like, you can contact with the author to suggest him features. By the
# way, do not ask him to make Login, he is working on that.

setudef flag rae
setudef flag coloresrae
global rae 

# Ignorar en segundos las siguientes peticiones para evitar flood
set rae(rest) 10

# Mostrar en varias líneas como si fuese copiar-pegar de la página. (Recomendado)
set rae(multiline) 1

# ¿Cuántas acepciones debe mostrar como máximo? Hay algunas palabras polisémicas
# que tienen un montón de acepciones y ejemplos que podrían llenar dos páginas
# del monitor. Hay que poner un número razonable.
set rae(max) 3

# ¿Quieres que este script que actualice automaticamente? (1) (0) No
set rae(autoupdate) 1

set rae(author) "HackeMate"
set rae(contact) "HackeMate <Sentencia@eggdrop.es>"
set rae(fileName) [info script]
set rae(projectName) "eggRae"
set rae(version) "1.0.1"
set rae(package.http) [package require http]
set rae(protection) ""

bind pub - !rae raePub
bind pub - !dicc raePub

proc raePub {nick uhost hand chan text} {
	
	if {![channel get $chan rae]} {
		if {$text eq "activar"} {
			channel set $chan +rae
			channel set $chan +coloresrae
			raeLog $chan "Modo de uso: /msg $chan !rae <nick> <palabra>. Especificando el nick (de este canal) se le enviará por privado en vez de al canal. Si no está en el canal, usa \":nick\""
			putserv "NOTICE $nick :Desde partyline puedes enviar una sugerencia al autor o comprobar la última versión disponible. (Teclea .rae en partyline)"
			return
		} else {
			putserv "NOTICE $nick :Este canal tiene el diccionario desactivado."
		}
		if {[matchattr $hand n]} {
			putserv "NOTICE $nick :Puedes activarlo así: /msg $chan !rae activar"
		}
        return
    }
	global rae
	regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $text "" arg
	
	# No se hace una protección independiente por cada canal porque cada petición
	# enviará a rae.es la búsqueda. Un posible flood a la página termina en un
	# ban temporal y automático a la ip del bot por parte de su servidor web
	# y eso no es lo que queremos.
	#
	if {![info exists rae(protection)]} {
		set rae(protection) [clock seconds]
	} else {
		if {![string is digit -strict $rae(protection)]} {
			set rae(protection) [clock seconds]
		} else {
			set time [expr [clock seconds]-$rae(protection)]
			if {$time >= $rae(rest)} {
				set rae(protection) [clock seconds]
			} else {
				raeLog log "Se omite la petición de $nick en $chan por protección."
				return
			}
		}
	}

	if {$arg eq ""} {
		putserv "NOTICE $nick :Especifica una palabra."
		return
	}
	set target [lindex [split $arg] 0]
	if {([onchan $target $chan]) && ([llength [split $arg]] > 1) || ([string index $target 0] eq ":")} {
		set arg [join [lrange [split $arg] 1 end]]
		set target [string trimleft $target ":"]
		raeLog log "$nick solicita $arg en $chan para $target"
		putserv "NOTICE $nick :$rae(projectName)\: enviando el significado de $arg a $target por privado..."
		set data [raeGet $arg "" "(De parte de $nick\, que está en $chan)"]
	} else {
		set target $chan
		raeLog log "$nick solicita $arg en $chan"
		set data [raeGet $arg]
	}
	# Este cambio se hace para palabras como alter ego, ipso facto
	if {![channel get $chan coloresrae]} {
		regsub -all -- {\017|\002|\037|\026|\003(\d{1,2})?(,\d{1,2})?} $data "" data
	}
	if {[string length $data] == 0} {
		set data "No he sido capaz de alcanzar esta palabra. Probablemente obtuve un tiempo de espera agotado. Intentalo mas tarde."
	}
	if {$rae(multiline) != "1"} {
		putserv "PRIVMSG $target :$data"
	} else {
		foreach line $data {
			putserv "PRIVMSG $target :$line"
		}
	}
}

proc raeLog {target info} {
	global rae
	if {![validchan $target]} {
		putlog "$rae(projectName)\: $info"
	} else {
		foreach line [split $info \n] {
			putserv "PRIVMSG $target :$info"
		}
	}
}


proc raeGet {ask {research ""} {redirect ""}} {	
	global rae tcl_platform plat
	if {$research eq ""} {
		regsub -all -- {\s+} $ask " " word
		set word [string tolower $word]
		set word [string trim $word]
	} else {
		set word $ask
	}
	set word [http::formatQuery $word]
	if {$tcl_platform(os) eq "Linux"} {
	    set platfrm "X11"
	} else {
		set platfrm $tcl_platform(os)
	}
	if {$redirect ne ""} {
		set research $redirect
	}
	http::config -useragent "Mozilla/5.0 ($platfrm; U; $tcl_platform(os) $tcl_platform(machine); en-ES; rv:1.9.0.3) Firefox 3.0.7" -accept "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8"
	set token [http::geturl http://buscon.rae.es/draeI/SrvltGUIBusUsual?LEMA=$word\&origen=RAE&TIPO_BUS=3 -timeout 10000]
	upvar #0 $token state
    set lastcode $state(http)
	set ncode ""
    regexp {[0-9]{3}} $lastcode ncode
    if {$ncode eq ""} {
        set ncode $lastcode
    }
    switch -- $ncode {
		"200" {
			
		}
		"404" {
			raeLog log "Error 404 obteniendo informacion de la palabra $word"
			return [list "Error 404"]
		}
		default {
			raeLog log "Error no identificado. El servidor respondió: $lastcode"
			return [list "Error no identificado. El servidor respondió: $lastcode"]
		}
	}
	set data $state(body)
	if {[string match -nocase "*Las que se muestran a continuaci*n tienen una escritura cercana*" $data]} {
		set data [encoding convertfrom utf-8 $data]
		set info {}
		set li [regexp -all -inline -- {<li align="left">(.*?)</li>} $data]
		regsub -all -- {\<[^\>]*\>|\t} $li "" li
		foreach {id liword} $li {
			lappend info [string trim $liword]
		}
		if {[llength $info] == 1} {
			return [raeGet $info "(Redirigido)"]
		}
		return "[list "La palabra $ask no está registrada en el Diccionario. ¿Quizá quisiste decir... [join $info ", "]\?."]"
	}
	if {[string match -nocase "*<TITLE>RAE. DRAE. Aviso de error.</TITLE>*" $data]} {
		return [list "\0034La palabra \002$ask\002 no está en el diccionario.\003"]
	}
	set acepLema ""
	set eEtimo ""
	set eLema ""
	# Sé que no es una manera elegante de deshacerse de este \u016 que iso8859-15
	# no es capaz de interpretar y termina en un \026 usado por irc para enviar
	# texto en color invertido, pero hasta ahora es la única manera efectia que
	# me ha funcionado. Si conoces la manera ideal, un email sería apreciado.
	regsub -all {â€– } $data "" data
	set data [encoding convertfrom utf-8 $data]
	set eLema ""
	regexp {<span class=\"eLema\">(.*?)</span>} $data "" eLema
	regsub -all -- {\<[^\>]*\>|\t} $eLema "" eLema
    set acepLema [regexp -all -inline {<span class="eOrdenAcepLema">(.*?)</p>} $data]
	if {$acepLema eq ""} {
		set acepLema [regexp -all -inline {<p style="margin-left:[0-9]em; margin-bottom:-0.5em">(.*?)</p>} $data]
		set eEtimo ""
		regexp {^.*?<span class=\"eEtimo\">(.*?)</p>} $data "" eEtimo
		regsub -all -- {\<[^\>]*\>|\t} $eEtimo "" eEtimo
		if {$eEtimo ne ""} {
			set newline "\002\0032$eLema\0033\002 $eEtimo\003 $research"
		} else {
			set newline "\002\0032$eLema\003\002 $research"
		}

		lappend result $newline
		set i 2
		foreach {id line} $acepLema {
			set num ""
			set genre ""
			set abrv ""
			set acep ""
			set ecomp ""
			regsub -all -nocase {<B>|</B>} $line "" line
			regexp -nocase {<span class="eOrdenAcepFC">(.*?)</span>} $line "" num
			regsub -all {\s+} $num " " num
			regexp -all {<span class="eFCompleja"> (.*?)</span>} $line "" ecomp
			regsub -all {\s+} $ecomp " " ecmop
			regexp -all {<span class="eAbrv" title=\"(.*?)\">} $line "" abrv
			regexp {<span class="eAcep">(.*?)</span>$} $line "" acep
			regsub -all -- {\<[^\>]*\>|\t} $line "" line
			regsub -all -- {<span class="eAbrv" title=\"(.*?)</span>} $acep "" acep
			set newline "[string trim $num][string trim $ecomp][string trim $abrv] $acep"
			if {[string length $newline] > 1} {
				lappend result $newline
			}
			if {$i > $rae(max)} {
				break
			}
			incr i
		}
		set ref [regexp -all -inline {<span class="eReferencia">(.*?)</p>} $data]
		set resultref {}
		foreach {id references} $ref {
			regsub -all -- {\<[^\>]*\>|\t} $references "" references
			lappend resultref [string trim $references]
		}
		lappend result "\0032Véase\003: [join $resultref ", "]"
		return $result
	}
	regexp {^.*?<span class=\"eEtimo\">(.*?)</p>} $data "" eEtimo
	regsub -all -- {\<[^\>]*\>|\t} $eEtimo "" eEtimo
	set total [expr [llength $acepLema] / 2]
	if {$total > $rae(max)} {
		set newline "\002\0032$eLema\0033\002 $eEtimo\003 (Se mostrarán $rae(max) de $total acepciones. El resto en: \00312\037http://rae.es/$word\003\037 $research"
	} else {
		set newline "\002\0032$eLema\0033\002 $eEtimo\003 $research"
	}
	lappend result $newline
	set i 2
	foreach {id line} $acepLema {
		set num ""
		set genre ""
		set abrv ""
		set acep ""
		set info {}
		regsub -all {\s+} $line " " line
		regexp -nocase {<B>(.*?)</B>} $line "" num
		regexp {<span class=\"eAbrvNoEdit\" title=\"(.*?)\">} $line "" genre
		regexp -all {<span class="eAbrv" title=\"(.*?)\">} $line "" abrv
		regexp {<span class="eAcep">(.*?)$} $line "" acep
		set acep [string map -nocase {"<b>" "\002" "</b>" "\002"} $acep]
		regsub -all -- {<span class="eAbrv" title=\"(.*?)</span>} $acep "" acep
		regsub -all -- {\<[^\>]*\>|\t} $acep "" acep
		if {$genre ne ""} {
			lappend info \00314$genre\003
		}
		if {$abrv ne ""} {
			lappend info \0032$abrv\003
		}
		lappend result "\002\00312$num\002\003 ([join $info ", "]) \0031$acep\003"
		if {$i > $rae(max)} {
			break
		}
		incr i
	}
	if {$rae(multiline) != "1"} {
		set result [join $result " | "]
	}
	return $result
}


bind dcc n rae communication::welcome

namespace eval communication {
	
	# communication.tcl --
	# 	This is a little library for eggdrop as internal use
	# 	It is done to portablility - You cannot use it without a file.cgi in your
	# 	http server. If you really want that, contact me.	
	variable version 1.0
	variable feedback {http://www.eggdrop.es/cgi-bin/feedback.cgi}
	variable update {http://www.eggdrop.es/cgi-bin/update.cgi}
	
	proc welcome {hand ipx text} {
		global rae
		set arg [lindex [split $text] 0]
		switch -- $arg {
			"feedback" {
				set contact [lindex [split $text] 1]
				set message [join [lrange [split $text] 1 end]]
				if {($contact eq "") || ($message eq "")} {
					putdcc $ipx "$rae(projectName) - Sugerencias"
					putdcc $ipx "Gracias por decirme lo que piensas."
					putdcc $ipx "Este comando enviará al autor tu mensaje para poder corregir o añadir funciones a este script. Puedes enviar uno por día aproximadamente"
					putdcc $ipx "Uso: .rae feedback <tu email (si quieres resputa, sino pon cualquier cosa)> <tu opinión, sugerencia o error al respecto>"
				} else {
					set result [[namespace current]::Feedback $contact $rae(projectName) $message]
					if {$result eq ""} {
						putdcc $ipx "El servidor no respondió nada, esto no es necesariamente un error. ¿Enviaste una sugerengia ya?"
						return
					}
					putdcc $ipx "El servidor respondió:"
					foreach line [split $result \n] {
						putdcc $ipx $line
					}
				}
			}
			"update" {
				set download [lindex [split $text] 1]
				putdcc $ipx [join [lrange [split [[namespace current]::Update $rae(fileName) $rae(projectName) $rae(version) $download]] 1 end]]
			}
			default {
				putdcc $ipx "Puedes usar '.rae update' para buscar la última versión o '.rae feedback' para enviar una sugerencia al autor."
			}
		}
	}
	
	proc Feedback {reporter projectName message} {
		variable feedback
		http::config -useragent "$reporter $projectName"
		set token [http::geturl "$feedback\?suggest=[http::formatQuery $message]" -timeout 4000]
		set data [http::data $token]
		http::cleanup $token
		return $data
	}
	
	proc Update {fileName projectName version {download ""}} {
		variable update
		set fs [open $fileName]
		set data [read $fs]
		close $fs
		set md5 [md5 $data]
		set query [http::formatQuery project $projectName version $version md5 $md5 download $download]
		set token [http::geturl "$update\?$query" -timeout 4000]
		set data [http::data $token]
		http::cleanup $token
        set result ""
        set info ""
        set url ""
		regexp {<!-- result -->(.*?)<!-- /result -->} $data "" result
		regexp {<!-- info -->(.*?)<!-- /info -->} $data "" info
		if {($download ne "") && ($download ne "no") && ($result == 1)} {
			regexp {<!-- data -->(.*?)<!-- /data -->} $data "" url
			if {![regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url]} {
				return "0 Invalid URL target file link."
			}
			set token [http::geturl $url -binary 1 -timeout 4000]
			set fileData [http::data $token]
            file rename -force -- $fileName $fileName\.bak
			set fs [open $fileName w]
			puts -nonewline $fs $fileData
			close $fs
            rehash
			set info "$projectName fue (purgado) cargado y cargado correctamente, estás usando la última versión disponible. Existe una copia de seguridad del fichero anterior en $fileName\.bak"
        }
		return "$result $info"
	}
}
if {![info exists rae(loaded)]} {
	if {$rae(autoupdate) == "1"} {
	    set rae(status) [communication::Update $rae(fileName) $rae(projectName) $rae(version) $rae(autoupdate)]
	    set rae(result) [lindex [split $rae(status)] 0]
	    set rae(info) [join [lrange [split $rae(status)] 1 end]]
	    raeLog log $rae(info)
	}
} 
raeLog log "[file tail $rae(fileName)] $rae(version) Cargado - por $rae(author) (Comando feedback y update activados, prueba .rae en partyline)"

set rae(loaded) 1