# Wetter
# by De Kus <DeKus@gmx.net>
#
# Script for the weather page www.wetter.com.
# further documentation and the complete script output in German,
# because its a German site.
#
# Eine kleine Hilfe erhaltet ihr, wenn ihr den Wetter Befehl ohne Parameter oder mit -hilfe aufruft.
#
# 0.5.2 03.06.2005 wettercacheupdate gefixt...
# 0.5.1 27.05.2005 Wind Chill um Humidex erweitert und als "gefühlt" bezeichnet
# 0.5   25.05.2005 Internationale Ortssuche verbessert, Wind Chill
# 0.4.1 17.04.2005 Nach Serverwartung musste nun das -crlf 1 für egghttp gesetzt werden
# 0.4   04.04.2005 Vorhersage eingebaut
# 0.3.5 02.04.2005 Möglichkeit für ausgeschlossene Channels eingebaut und ein Kompatibilitäts Problem gelöst
# 0.3.4 01.04.2005 egghttp Version 1.1.0+ wird verlangt.
# 0.3.3 31.03.2005 Partyline befehl .wetterreset hinzugefügt.
# 0.3.2 29.03.2005 Beim Laden des Scripts wird die Verfügbarkeit der Cachedatei sichergestellt.
# 0.3.1 29.03.2005 Versuch "Achtungs" Zeilen anzuzeigen, endgültiger Test war nicht möglich
# 0.3   28.03.2005 Regexp optimierung durch verwendung der expressions als array
# 0.2.2 21.02.2005 verwendet nun IP für CONNECT, welche asyncron durch die domain bezogen wird.
# 0.2.1 21.02.2005 Ortsuche und Cache verfeinert
# 0.2   20.02.2005 komplett umgeschrieben von http auf egghttp
# 0.1.1 19.02.2005 kleinere Änderung des Einleseausdrucks und des Caches.
# 0.1   19.02.2005 Ausgabe ohne Vorschau in langem un kurzem Format.
# 0.0.2 19.02.2005 Ort ID Suche und Cache funzt, erste Wetter Ausgabe streikt noch
# 0.0.1 15.02.2005 Beginn des Marathon

#
# Konfiguration
#

# maximale replys pro 5 minuten (timer 5)
set wetter(floodmax) 3

# Datei in der die Ortsuchen gespeichert werden. Beschleunigt die Ausgabe und reduziert Traffik etc.
# Falls es einen ungünstigen Eintrag gibt, kann sie per Hand bearbeitet werden,
# da die Datei für jede Anfrage neu geladen wird.
set wetter(cachedatei) "wetter.cache"

# Leerzeichen getrennte Liste Channels in denen !wetter nicht gehen soll
set wetter(nichtdort) ""

set wetter_cmd "!wetter"

#
# Begin Code
#

if { ![info exists egghttp(version)] } {
	putlog "Could not verify egghttp.tcl beeing loaded!"
} else {
# kein einrücken, Klammer zu ist extra kommentiert
if { [string range $egghttp(version) 0 0] < 1 || [string range $egghttp(version) 2 end] < 1.0 } {
	putlog "Your egghttp.tcl seems to be outdated!"
}

bind pub - $wetter_cmd getwetter_cmd
bind msg - $wetter_cmd getwetter_msgcmd
bind dcc m wetterreset wetterreset
bind dcc n wettercacheupdate wettercacheupdate

set wetter(flood) 0
set wetter(inuse) 0

set re(wetter1) {\046type=([^\046]+)\046?[^\n]*\046id=([0-9]+)}
set re(wetter2) {\046type=([^\046]+)\046?[^\n]*\046id=([0-9]+)\042}
set re(wetter4) {class="HeadlineXL">([A-Za-z ()]{3,30})}
set re(wetter5) {"border-left: none;">(.{3,20})</td>(.*)"HeadlineXL">(.{1,5}) &deg;C(.*)"border-left: none;">(.*)"border-left: none;">(.{3,9})</td>(.*)"border-left: none;">(.{4,7})</td>(.*)"border-left: none;">(.{4,9})</td>(.*)"border-left: none;">(.{3,8})</td>(.*)"border-left: none;">(.{4,10})</td>(.*)"border-left: none;">(.{1,5})</td>(.*)"border-left: none;">(.{4,7})</td>}
set re(wetter6) {\t<span class="BodyWhite">(.{5,50})<br></span>}
set re(wetter7) {="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %).+="line-height: 15px;">.{1,3}\t{6}(.{5,20})<br>.+\t(-?[0-9]{1,2} &deg;C)<br>\t{6}([0-9]{1,3} %|k.A. %)}
set re(wetter8) {="line-height: 20px;">(-?[0-9]{1,2} / -?[0-9]{1,2} &deg;C)<.+="line-height: 20px;">(-?[0-9]{1,2} / -?[0-9]{1,2} &deg;C)<.+="line-height: 20px;">(-?[0-9]{1,2} / -?[0-9]{1,2} &deg;C)<}

#damit umgehen wir die Benutzung syncrone Nutzung von gethostbyname durch CONNECT in egghttp
dnslookup www.wetter.com getwetterdns:cb
proc getwetterdns:cb {ip host status} {
	set ::wetter(server) $ip
}
if { ![file exists $wetter(cachedatei)] } {
	if { [catch {set wetterdatei [open $wetter(cachedatei) w]} err] } {
		putlog "wetter.tcl: Kann Datei '$wetter(cachedatei)' nicht zum Schreiben öffnen: $err"
	} else {
		putlog "wetter.tcl: Cachedatei '$wetter(cachedatei)' angelegt."
	}
	close $wetterdatei
	catch {unset err}
	unset wetterdatei
}

proc getwetter_msgcmd {nick uhost hand text} {
	getwetter_cmd $nick $uhost $hand $nick $text
	return 1
}

proc getwetter_cmd {nick uhost hand chan text} {
	global wetter re
	set text [split $text]
	set param(lang) 0
	set param(hilfe) 0
	set param(vorschau) 0
	while {[string match "-*" [lindex $text 0]]} {
		switch [string trimleft [lindex $text 0] "-"] {
			l				-
			lang {
				if { [matchattr $hand of|of $chan] || $nick == $chan } {
					set param(lang) 1
				}
			}
			v					-
			v1				-
			vorschau	-
			vorschau1	{set param(vorschau) 1}
			v2				-
			vorschau2 {set param(vorschau) 2}
			v3				-
			vorschau3 {set param(vorschau) 3}
			default		{set param(hilfe) 1}
		}
		set text [lreplace $text 0 0]
	}
	if { $param(hilfe) || $text == "" } {
		puthelp "NOTICE $nick :Das Wetter wird von www.wetter.com abgerufen, dies dauert gewöhnlich einige Sekunden. Mögliche Parameter (Anfangsbuchstaben genügen) sind:"
		puthelp "NOTICE $nick : \002 -lang\002: extra langes Ausgabeformat (op/friend oder Query Beschränkung)."
		puthelp "NOTICE $nick : \002 -vorschau\002: Gibt die Vorschau für heute an."
		puthelp "NOTICE $nick : \002 -vorschau2\002: Gibt die Vorschau für morgen an."
		puthelp "NOTICE $nick : \002 -vorschau3\002: Gibt die Vorschau für übermorgen an."
		puthelp "NOTICE $nick :Den gewünschten Ort schreibt ihr einfach ganz hinten hin als Name oder PLZ, wahlweise könnt ihr mit Komma das Bundesland anhängen. Bitte darauf achten, dass automatisch das erste Ergbnis gewählt wird!"
		return 0
	} elseif { [lsearch $wetter(nichtdort) $chan] != -1 } {
		puthelp "NOTICE $nick :Bitte benutze den Befehl in einem anderen Channel oder im Query"
		return 0
	} elseif { $wetter(inuse) == 1 || ($wetter(flood) >= $wetter(floodmax) && ![matchattr $hand of|of $chan]) } {
		puthelp "NOTICE $nick :Floodschutz aktiv, bitte warte einige Minuten. Falls sich nichts ändert, trat womöglich woher ein TCL Fehler auf."
		return 0
	}
	incr wetter(flood)
	timer 5 wetterflood
	set wetter(inuse) 1
	set wetter(chan) $chan
	set wetter(lang) $param(lang)
	set wetter(nick) $nick
	set wetter(vorschau) $param(vorschau)
	set wetter(loc) [string trim [lindex [split $text ","] 0]]
	set wetter(loc2) [string trim [lindex [split $text ","] 1]]
	set wetter(error) 0
	getwetterloc
	return 1
}

proc getwetterloc {} {
	global wetter
	set ort ""
	set wetterdatei [open $wetter(cachedatei) r]
		set wettercache [gets $wetterdatei]
	close $wetterdatei
	foreach entry $wettercache {
		foreach "id mode nummer name ext" $entry {
			if { $nummer == $wetter(loc) || [string equal -nocase $name $wetter(loc)] && [string match -nocase *$wetter(loc2)* $ext] } {
				if { [string is integer $id] } {
					set ort $id
					set type $mode
				} else {
					puthelp "NOTICE $wetter(nick) :Fehler in der Cache Datei, erwartete einen Integer aber erhielt '$id'."
					set wetter(error) 1
				}
				break
			}
		}
	}
	if { $ort == "" } {
		set query "http://$wetter(server)/v2/?SID=&LANG=DE&LOC=7004&LOCFROM=0002&LOCFULL=7000&search=$wetter(loc)"
		if { [catch {egghttp:geturl $query getwetterloc:cb -crlf 1} err] } {
			puthelp "NOTICE $wetter(nick) :Fehler '$err' beim Öffnen der HTTP Verbindung zu wetter.com. Homepage down?!"
			set wetter(error) 1
		}
	} else {
		set wetter(ort) $ort
		set wetter(type) $type
		getwetter
	}
}

proc getwetterloc:cb {token} {
	global wetter re
	set ort ""
	set name ""
	set ext1 ""
	set ext2 ""
	set headers [egghttp:headers $token]
	set body [egghttp:data $token]
	if { [egghttp:code $token] == 302 } {
		regexp $re(wetter1) $headers {} type ort
	} else {
		regexp $re(wetter2) $body {} type ort
		set re(wetter3) "(?i)\042 class=\042Headline\042>(.{2,30})</a>,(.{1,30})$wetter(loc2)(.{1,30})\\050(.{3,6})\\051\t"
		regexp $re(wetter3) $body {} name ext1 ext2 nummer
		set ext [string trim [lindex [split "$ext1$wetter(loc2)$ext2" ","] 0]]
	}
	egghttp:cleanup $token
	if { $ort != "" } {
		set wetterdatei [open $wetter(cachedatei) r]
			set wettercache [gets $wetterdatei]
		close $wetterdatei
		if { $name == "" } {
			if { [string is integer $wetter(loc)] } {
				lappend wettercache [list $ort $type $wetter(loc) . .]
			} else {
				lappend wettercache [list $ort $type . $wetter(loc) .]
			}
		} else {
			lappend wettercache [list $ort $type $nummer $name $ext]
		}
		set wetterdatei [open $wetter(cachedatei) w]
			puts $wetterdatei $wettercache
		close $wetterdatei
		set wetter(ort) $ort
		set wetter(type) $type
		getwetter
	} else {
		puthelp "NOTICE $wetter(nick) :Fehler, kann den Ort '[string trim "$wetter(loc), $wetter(loc2)" ", "]' nicht finden."
		wetterquit
	}
}

proc getwetter {} {
	global wetter
	if { $wetter(vorschau) == 0 } {
		set query "http://$wetter(server)/v2/?SID=&LANG=DE&type=$wetter(type)&LOC=7001&LOCFROM=7000&id=$wetter(ort)"
	} else {
		set query "http://$wetter(server)/v2/?SID=&LANG=DE&type=$wetter(type)&LOC=7000&LOCFROM=7000&id=$wetter(ort)"
	}
	if { [catch {egghttp:geturl $query getwetter:cb -crlf 1} err] } {
		puthelp "NOTICE $wetter(nick) :Fehler '$err' beim Öffnen der HTTP Verbindung zu wetter.com. Homepage down?!"
		set wetter(error) 1
	}
}

proc getwetter:cb {token} {
	global wetter re
	if { $wetter(error) == 0 } {
		set name ""
		set headers [egghttp:headers $token]
		set body [egghttp:data $token]
#		set wetterdatei [open wetter.txt w]
#			puts $wetterdatei "$headers"
#			puts $wetterdatei ""
#			puts $wetterdatei "$body"
#		close $wetterdatei
		regexp $re(wetter4) $body {} name
		if { [string match "*Zur Zeit liegen leider keine aktuellen Wetterdaten vor*" $body] } {
				puthelp "NOTICE $wetter(nick) :Fehler, es liegen keine aktuellen Wetterdaten vor für '[string trim "$wetter(loc), $wetter(loc2)" ", "]'."
		} elseif { $name == "" } {
				puthelp "NOTICE $wetter(nick) :Fehler beim Phrasen der Wetterseite für '[string trim "$wetter(loc), $wetter(loc2)" ", "]'."
		} elseif { $wetter(vorschau) == 0 } {
			set himmel ""
			set temp ""
			set winds ""
			set windr ""
			set windg ""
			set windb ""
			set feuchte ""
			set sicht ""
			set druck ""
			regexp $re(wetter5) $body {} himmel {} temp {} {} windr {} windg {} winds {} windb {} druck {} feuchte {} sicht
			set windn [lindex [split $windg] 0]
			set windchill [expr round((33+(0.478+0.237*sqrt($windn)-0.0124*$windn)*($temp-33))*10)/10.0]
			set x [expr 1 - 0.01 * [string map {" " "" % ""} $feuchte]]
			set gefuil [expr $windchill + round(((0.5555)*((6.11 * exp(5417.7530 * ((1/273.16) - (1/($temp - ((14.55 + 0.114 * $temp)* $x + pow([expr (2.5 + 0.007 * $temp) * $x],3) + (15.9 + 0.117 * $temp) * pow($x,14)) + 273.15))))) - 10.0)) * 10) / 10.0]
			if { $wetter(lang) == 0 } {
				puthelp "PRIVMSG $wetter(chan) :In $name ist es $temp ($gefuil) °C, das Wetter ist $himmel und es weht ein Wind mit $winds aus $windr."
			} else {
				puthelp "PRIVMSG $wetter(chan) :Deteilierte \002Wetterübersicht\002 für $name:"
				puthelp "PRIVMSG $wetter(chan) :\002Temperatur (gefühlt) & Wetter:\002 $temp ($gefuil) °C, $himmel"
				puthelp "PRIVMSG $wetter(chan) :\002Wind:\002 $winds ($windg mit Böen bis $windb) aus $windr"
				puthelp "PRIVMSG $wetter(chan) :\002Luftdruck & -feuchtigeit:\002 $druck, $feuchte"
				puthelp "PRIVMSG $wetter(chan) :\002Sicht:\002 $sicht"
				set achtung ""
				regexp -all $re(wetter6) $body {} achtung
				set achtungl [llength $achtung]
				for {set i 1 } { $achtungl > $i } { incr i 2} {
					puthelp "PRIVMSG $wetter(chan) :\002Achtung\002: [lindex $achtung $i]"
				}	
			}
		} else {
			set himmel() ""
			set temp() ""
			set ns() ""
			set minmax() ""
			regexp $re(wetter7) $body {} himmel(1) temp(1) ns(1) himmel(2) temp(2) ns(2) himmel(3) temp(3) ns(3) himmel(4) temp(4) ns(4) himmel(5) temp(5) ns(5) himmel(6) temp(6) ns(6) himmel(7) temp(7) ns(7) himmel(8) temp(8) ns(8) himmel(9) temp(9) ns(9)
			regexp $re(wetter8) $body {} minmax(1) minmax(2) minmax(3)
			switch $wetter(vorschau) {
				1	{
					set vor 1
					set tag "heute"
				}
				2	{
					set vor 4
					set tag "morgen"
				}
				3	{
					set vor 7
					set tag "übermorgen"
				}
			}
			if { $wetter(lang) == 0 } {
				puthelp "PRIVMSG $wetter(chan) :In $name soll es laut Vorhersage für $tag Mittag $himmel([expr $vor + 1]) werden, [string map {&deg; \260} $temp([expr $vor + 1])] haben und die Chance auf Niederschlag ist $ns([expr $vor + 1])."
			} else {
				puthelp "PRIVMSG $wetter(chan) :Deteilierte \002Wettervorhersage\002 für $tag in $name:"
				puthelp "PRIVMSG $wetter(chan) :\002Morgens:\002 [string map {&deg; \260} $temp($vor)], $himmel($vor), Niederschlag: $ns($vor)"
				puthelp "PRIVMSG $wetter(chan) :\002Mittags:\002 [string map {&deg; \260} $temp([expr $vor + 1])], $himmel([expr $vor + 1]), Niederschlag: $ns([expr $vor + 1])"
				puthelp "PRIVMSG $wetter(chan) :\002Abends :\002 [string map {&deg; \260} $temp([expr $vor + 2])], $himmel([expr $vor + 2]), Niederschlag: $ns([expr $vor + 2])"
				puthelp "PRIVMSG $wetter(chan) :\002Tempaturhoch Tief / Hoch:\002 [string map {&deg; \260} $minmax($wetter(vorschau))]"
			}
		}
	}
	egghttp:cleanup $token
	wetterquit
}

proc wetterflood {} {
	global wetter
	if { $wetter(flood) <= 1 } {
		set wetter(flood) 0
	} else {
		incr wetter(flood) -1
	}
}

proc wetterreset {idx hand text} {
	wetterquit
	return 1
}

proc wettercacheupdate {hand idx text} {
	putdcc $idx "Lade Wettercache..."
	set wetterdatei [open $::wetter(cachedatei) r]
		gets $wetterdatei wettercache
	close $wetterdatei
	if { [llength [lindex $wettercache 0]] == 4 } {
		putdcc $idx "Konvertiere..."
		foreach element $wettercache {
			lappend wettercacheneu [linsert $element 1 "WORLD"]
		}
		set wetterdatei [open $::wetter(cachedatei) w]
			puts $wetterdatei $wettercacheneu
		close $wetterdatei
		putdcc $idx "fertig"
		putdcc $idx "Neuer Inhalt: $wettercacheneu"
	} else {
		putdcc $idx "Fehler: die Datei ist leer, fehlerhaft oder schon aktuell."
		return 0
	}
	return 1
}

proc wetterquit {} {
	global wetter
	catch {unset wetter(chan)}
	catch {unset wetter(lang)}
	catch {unset wetter(vorschau)}
	catch {unset wetter(nick)}
	catch {unset wetter(loc)}
	catch {unset wetter(loc2)}
	catch {unset wetter(ort)}
	catch {unset wetter(type)}
	catch {unset wetter(error)}
	set wetter(inuse) 0
}
	

putlog "Wetter.tcl v0.5.2 geladen!"

# Klammer zu von egghttp check
}

# Copyright © 2005 De Kus
# This tcl script (Wetter) for the eggdrop IRC bot is
# released under GNU GPL, refer GPL.txt included in the archive.
#
# 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 2
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.