# foreca.tcl v1.7 by Vertigo@RusNet # last modified: 06-04-2012 # ————————————————————————— # ïîãîäà ñ www.foreca.com # âêëþ÷åíèå íà êàíàëå - .chanset #chan +fweather namespace eval ::foreca { package require http 2.7 package require Tcl 8.5 bind pub - !ïô [namespace current]::weather:pub bind pub - !wf [namespace current]::weather:pub bind msg - !ïô [namespace current]::weather:msg bind msg - !wf [namespace current]::weather:msg # âûäàâàòü â êðàòêîì ôîðìàòå ïîãîäó èëè åùå íà 3 äíÿ âïåðåä? # òàêæå ïîëíûé ôîðìàò äîñòóïåí ïðè óêàçàíèè "+" â çàïðîñå variable fullformat "1" # àäðåñ ñàéòà variable site "http://www.foreca.com/" # òàéìàóò ñîåäèíåíèÿ ñ ñàéòîì (ñåêóíäû) variable timeout "30" # çàäåðæêà íà ïîâòîðíûé âûçîâ êîìàíäû variable timer "10" variable useragent "Opera/9.80 (Windows NT 5.1; U; ru) Presto/2.6.30 Version/10.62" variable chflag fweather setudef flag $chflag variable fcookies "lv=cnU6MTAwNDYzODI5O3J1OjEwMDU4MTA0OTtydToxMDA1MjQ5MDE%3D; lang%3Dru%26units%3Dmetricmmhg%26tf%3D24h%26ml%3D%26u%3DZ3VUUX5TZQPA" variable version "1.7" proc weather:msg {nick uhost hand text} { weather:pub $nick $uhost $hand $nick $text return 1 } proc weather:pub {nick uhost hand chan text} { variable chflag variable timer if {$chan != $nick && ![channel get $chan $chflag]} {return} if {[info exists [namespace current]::wait] && [expr [clock seconds] - $[namespace current]::wait] < $timer && ![matchattr $hand F]} { putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Êîìàíäà íåäàâíî çàïðàøèâàëàñü. Ïîâòîðè ïîïûòêó ÷åðåç [expr $timer - ([clock seconds] - $[namespace current]::wait)] ñåê." return 0 } set [namespace current]::wait [clock seconds] if {[string is space $text] && [validuser $hand] && ![string is space [set fcity [getuser $hand XTRA fcity]]]} { set text $fcity } if {[regexp -- {^-set\s([a-zà-ÿA-ZÀ-߸¨0-9\x20\_]+)$} $text - ucity]} { if {![validuser $hand]} { putserv "NOTICE $nick :Íåäîñòàòî÷íî ïðàâ äëÿ óñòàíîâêè \"äîìàøíåãî\" ãîðîäà." return } else { setuser $hand XTRA fcity $ucity putserv "NOTICE $nick :\"Äîìàøíèé\" ãîðîä óñòàíîâëåí êàê \"$ucity\". Òåïåðü êîìàíäó ìîæíî íàáèðàòü áåç óêàçàíèÿ ãîðîäà." return } } elseif {[regexp -- {^-unset$} $text]} { if {![validuser $hand]} { putserv "NOTICE $nick :Íåäîñòàòî÷íî ïðàâ äëÿ óäàëåíèÿ \"äîìàøíåãî\" ãîðîäà." return } else { setuser $hand XTRA fcity "" putserv "NOTICE $nick :\"Äîìàøíèé\" ãîðîä óäàëåí. Òåïåðü êîìàíäó íóæíî íàáèðàòü ñ óêàçàíèåì ãîðîäà." return } } if {[string is space $text]} { putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Èñïîëüçóé $::lastbind \[-÷èñëî\] \[+\]\<ãîðîä\> - ïîãîäà â óêàçàííîì ãîðîäå. Çíàê \"+\" ïåðåä ãîðîäîì - êðàòêàÿ ïîãîäà íà áëèæàéøèå 3 ñóòîê." if {[validuser $hand]} {putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Òû òàêæå ìîæåøü óñòàíîâèòü \"äîìàøíèé\" ãîðîä, èñïîëüçóÿ $::lastbind -set <ãîðîä> è â äàëüíåéøåì íàáèðàòü êîìàíäó áåç óêàçàíèÿ ãîðîäà. Äëÿ óäàëåíèÿ èñïîëüçóé $::lastbind -unset."} return } if {[regexp -- {^-(\d+)} $text -> num]} { set num_ 1 regsub -- "^-$num\s?" $text "" text } else { set num_ 0 set num 1 } set ext 0 variable fullformat if {[string match "*+*" $text] || $fullformat == "1"} {set text [string map {+ ""} $text]; set ext 1} if {[string length $text] > 60} { putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Íàçâàíèå ãîðîäà íå ìîæåò áûòü äëèííåå 60 ñèìâîëîâ." return } if {[string length $text] < 2} { putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Íàçâàíèå ãîðîäà íå ìîæåò áûòü êîðî÷å 3 ñèìâîëîâ." return } if {[string tolower $text] eq "ìîñêâà" && $num_ == "0"} {set num "2"} variable timeout variable useragent variable site variable fcookies ::http::config -useragent $useragent -urlencoding utf-8 if {[catch { set token [::http::geturl $site \ -method POST \ -protocol 1.0 \ -query [::http::formatQuery loc_id "" continent_id "" country_id "" geode_lon "" geode_lat "" q $text do_search "Find place"] \ -headers [list "Accept-Language" "ru-RU,ru;q=0.9,en;q=0.8" "Accept-Charset" "iso-8859-1, utf-8, utf-16, *;q=0.1" Cookie $fcookies] \ -timeout [expr $timeout * 1000] \ -command [list [namespace current]::weather:data $nick $chan [scan $num %d] 1 $ext]] } err]} { putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Îøèáêà ïðè ïîäêëþ÷åíèè ê óäàëåííîìó ñåðâåðó: $err" return 1 } } proc weather:data {nick chan num total ext token} { set ncode [::http::ncode $token] set status [::http::status $token] array set meta [::http::meta $token] variable site variable timeout variable fcookies ::http::config -urlencoding cp1251 if {[string index $ncode 0] == "3" && [info exists meta(Location)]} { ::http::cleanup $token #putserv "PRIVMSG $chan :[string map {{%2f} {/}} [::http::formatQuery [encoding convertfrom cp1251 $meta(Location)]]]" if {[catch { set token [::http::geturl "$site[string map {{%2f} {/}} [::http::formatQuery [encoding convertfrom cp1251 $meta(Location)]]]" \ -timeout [expr $timeout * 1000] \ -protocol 1.0 \ -headers [list "Accept-Language" "ru-RU,ru;q=0.9,en;q=0.8" "Accept-Charset" "iso-8859-1, utf-8, utf-16, *;q=0.1" Cookie $fcookies] \ -command [list [namespace current]::weather:data $nick $chan $num $total $ext]] } err]} { putserv "[expr {$nick == $chan ? "PRIVMSG":"NOTICE"}] $nick :Îøèáêà ïðè ïîäêëþ÷åíèè ê óäàëåííîìó ñåðâåðó ïîñëå ïåðåíàïðàâëåíèÿ: $err" return 1 } return } if {$ncode != "200" || $status ne "ok"} { ::http::cleanup $token putserv "PRIVMSG $chan :Ñåðâåð âåðíóë $ncode-êîä îøèáêè èëè ïðîèçîøåë òàéìàóò ñîåäèíåíèÿ." putserv "PRIVMSG $chan :Ìåòà çàãîëîâêè: [array get meta]" return 0 } set data [::http::data $token] ::http::cleanup $token regsub -all -- "\n|\r|\t" $data "" data if {[string match -nocase "*No results*" $data] || [string match -nocase "*áåç ðåçóëüò*" $data]} { putserv "PRIVMSG $chan :Íåò ðåçóëüòàòîâ." return } if {[regexp -nocase -- {
.*?(.+?)} $data -> data]} { set clist [list] foreach _ [split [string map {{$} $data "" data
if {[string match -nocase "*No results*" $data] || [string match -nocase "*áåç ðåçóëüò*" $data]} {
putserv "PRIVMSG $chan :Íåò ðåçóëüòàòîâ."
return
}
set temp "N/A"
set windd ""
set windv ""
set sky "N/A"
set ftemp "N/A"
set pres "N/A"
set bpnt "N/A"
set relw "N/A"
set time "N/A"
catch {::egglib::writedata fw.txt [list $data]}
regexp -nocase -- {.*?src=".*?/symb-wind/.*?.gif" alt="(.*?)".*?(.*?)
} $data -> windd windv
regexp -nocase -- {<.*?class=".*?txt-xxlarge">(.*?).*?} $data -> temp
if { ![regexp -nocase -- {