weather.tcl (16953B)
1 blocktnd weatherserv 2 blocktnd wshelp 3 4 #source weatherserv.help 5 6 llbind - evnt - alive weatherserv.connect 7 8 proc weatherserv.connect {arg} { 9 puts stdout [format "there are %s weatherserv blocks" [set blocks [tnda get "openconf/[ndcenc weatherserv]/blocks"]]] 10 for {set i 1} {$i < ($blocks + 1)} {incr i} { 11 if {[string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc weatherserv] $i]] 0]] != [string tolower $arg]} {continue} 12 after 1000 [list weatherserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc weatherserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc weatherserv] $i]]] 13 } 14 } 15 16 proc weatherserv.find6sid {n s {hunting 0}} { 17 # we're trying to get the sid of the server named $s 18 # if hunting, we're looking for the first splat match 19 set servs [tnda get "servers/$n"] 20 foreach {.k dv} $servs { 21 set k [string toupper [ndadec ${.k}]] 22 # name description uplink sid - we only need two 23 dictassign $dv name sname 24 if {$hunting} { 25 if {[string match [string tolower $s] [string tolower $sname]] == 1} {return $k} 26 } { 27 if {[string tolower $s] == [string tolower $sname]} {return $k} 28 } 29 } 30 return "" 31 } 32 33 proc weatherserv.oneintro {headline block} { 34 set net [lindex $headline 0] 35 set nsock $::sock($net) 36 setctx $net 37 dictassign $block logchan logchan nick nick ident ident host host modes modes realname realname operflags rehashprivs idcommand nspass \ 38 nickserv nickserv nsserv nsserv 39 tnda set "weather/[curctx net]/operflags" $rehashprivs 40 tnda set "weather/[curctx net]/logchan" $logchan 41 #tnda set "weather/[curctx net]/nspass" $nspass 42 setctx $net 43 % sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* Debug Service *" : $realname}] $modes 44 tnda set "weather/[curctx net]/ourid" $ourid 45 # llbind $nsock pub - ".metadata" [list weatherserv.pmetadata $net] 46 # llbind $nsock pub - ".rehash" [list weatherserv.crehash $net] 47 if {[string length $nspass] != 0 && [string length $nickserv] != 0} { 48 # only works if nettype is ts6! 49 if {[string first [weatherserv.find6sid $net $nsserv] [% nick2uid $nickserv]] == 0} { 50 % privmsg $ourid $nickserv $nspass 51 } { 52 % privmsg $ourid $logchan [gettext weatherserv.impostornickserv $nickserv [nick2uid $nickserv] $nsserv [weatherserv.find6sid $net $nsserv]] 53 } 54 } 55 after 650 [list % putjoin $ourid $logchan] 56 after 950 [list % putmode $ourid $logchan "+ao" [format "%s %s" [% intclient2uid $ourid] [% intclient2uid $ourid]]] 57 # llbind $nsock msg [tnda get "weather/[curctx net]/ourid"] "metadata" [list weatherserv.metadata $net] 58 # llbind $nsock msg [tnda get "weather/[curctx net]/ourid"] "rehash" [list weatherserv.rehash $net] 59 # llbind $nsock pub - "gettext" [list weatherserv.gettext $net] 60 # puts stdout "llbind $nsock msg [tnda get "weather/[curctx net]/ourid"] metadata [list weatherserv.metdata $net]" 61 puts stdout [format "Connected for %s: %s %s %s" $net $nick $ident $host] 62 llbind $nsock pub - "!quote" [list weatherservdo $net] 63 llbind $nsock evnt - privmsg [list ws.pmdo $net] 64 puts stdout $::nd 65 foreach {chan is} [nda get "weather/[curctx net]/regchan"] { 66 puts stdout "to join $chan on [curctx]" 67 if {1!=$is} {continue} 68 weatherjoin [ndadec $chan] 0 69 # % putjoin [tnda get "weather/[curctx net]/ourid"] [::base64::decode [string map {[ /} $chan]] [nda get "regchan/$chan/ts"] 70 # tnda set "channels/$chan/ts" [nda get "regchan/$chan/$::netname([curctx sock])/ts"] 71 } 72 } 73 74 #$::maintype sendUid [curctx sock] "W" "weather" "services." "services." 57 "Weather Services" 75 llbind [curctx sock] request "w" "-" weatherjoin 76 llbind [curctx sock] request "weather" "-" weatherjoin 77 78 proc weatherjoin {chan {setting 1}} { 79 set ndacname [string map {/ [} [::base64::encode [string tolower $chan]]] 80 puts stdout "to join $chan on [curctx]" 81 % putjoin [tnda get "weather/[curctx net]/ourid"] $chan 82 % putmode [tnda get "weather/[curctx net]/ourid"] $chan "+ao" \ 83 [format "%s %s" [% intclient2uid [tnda get "weather/[curctx net]/ourid"]]\ 84 [% intclient2uid [tnda get "weather/[curctx net]/ourid"]]] 85 if {$setting} {nda set "weather/[curctx net]/regchan/$ndacname" 1} 86 } 87 88 proc weatherpart {chan {who "the script"} {msg isunused}} { 89 set ndacname [string map {/ [} [::base64::encode [string tolower $chan]]] 90 % putpart [tnda get "weather/[curctx net]/ourid"] $chan [gettext weather.left $who] 91 nda set "weather/[curctx net]/regchan/$ndacname" 0 92 nda unset "weather/[curctx net]/regchan/$ndacname" 93 } 94 95 proc weatherenabled {chan} { 96 set ndacname [string map {/ [} [::base64::encode [string tolower $chan]]] 97 if {[nda get "weather/[curctx net]/regchan/$ndacname"] == 1} {return 1} {return 0} 98 } 99 100 ############################################################################################## 101 ## ## wunderground.tcl for eggdrop by Ford_Lawnmower irc.geekshed.net #Script-Help ## ## 102 ############################################################################################## 103 ## To use this script you must set channel flag +weather (ie .chanset #chan +weather) ## 104 ############################################################################################## 105 ############################################################################################## 106 ## ## Start Setup. ## ## 107 ############################################################################################## 108 namespace eval wunderground { 109 ## Edit logo to change the logo displayed at the start of the line ## ## 110 variable logo "\017\00304\002W\00304u\00307n\00308d\00311e\00312r\00304g\00307r\00308o\00311u\00312n\00304d\017" 111 ## Edit textf to change the color/state of the text shown ## ## 112 variable textf "\017" 113 ## Edit tagf to change the color/state of the Tags: ## ## 114 variable tagf "\017\002" 115 ## Edit weatherline, line1, line2, line3, line4 to change what is displayed ## ## 116 ## weatherline is for the !weather trigger and line1-4 are for !forecast ## ## 117 ## Valid items are: location weatherstation conditions tempf tempc tempfc feelsf ## ## 118 ## feelsc feelsfc windgust windspeed winddirection sunset sunrise moon ## ## 119 ## day1 day2 day3 day4 day5 day6 day7 day8 day9 day10 ## ## 120 ## Do not remove any variables here! Just change them to "" to suppress display ## ## 121 variable line1 "location weatherstation conditions tempfc feelsfc windspeed winddirection windgust sunset sunrise moon" 122 variable line3 "" 123 variable line2 "day1 day2 day3 day4 day5 day6 day7 day8 day9 day10" 124 variable line4 "" 125 variable weatherline "location weatherstation conditions tempfc feelsfc windspeed winddirection windgust sunset sunrise moon day1 day2 day3" 126 ## Edit cmdchar to change the !trigger used to for this script ## ## 127 variable cmdchar "!" 128 ############################################################################################## 129 ## ## End Setup. ## ## 130 ############################################################################################## 131 llbind [curctx sock] pub "-" [string trimleft $wunderground::cmdchar]weather wunderground::tclservwe 132 llbind [curctx sock] pub "-" [string trimleft $wunderground::cmdchar]wz wunderground::tclservwe 133 llbind [curctx sock] pub "-" [string trimleft $wunderground::cmdchar]forecast wunderground::tclservfc 134 } 135 136 proc wunderground::tclservwe {n cname i msg} { 137 if {[weatherenabled $cname] == 0} {return} 138 set nick [tnda get "nick/$::netname([curctx sock])/$i"] 139 set host "[tnda get "ident/$i"]@[tnda get "vhost/$::netname([curctx sock])/$i"]" 140 set comd "weather" 141 set hand "" 142 set text $msg 143 wunderground::main $comd $nick $host $hand $cname $text 144 } 145 146 proc wunderground::tclservfc {n cname i msg} { 147 if {[weatherenabled $cname] == 0} {return} 148 set nick [tnda get "nick/$::netname([curctx sock])/$i"] 149 set host "[tnda get "ident/$i"]@[tnda get "vhost/$::netname([curctx sock])/$i"]" 150 set comd "forecast" 151 set hand "" 152 set text $msg 153 wunderground::main $comd $nick $host $hand $cname $text 154 } 155 156 proc wunderground::main {command nick host hand chan text} { 157 set search [strip $text] 158 set div ""; set moon ""; set sunset ""; set sunrise ""; set windspeed ""; set div "" 159 set winddirection ""; set location ""; set weatherstation ""; set temperature ""; set tempfc "" 160 set conditions ""; set feelslike ""; set feelsf ""; set feelsc ""; set city ""; set day "" 161 set details ""; set forc ""; set count 1; set tempf ""; set state_name ""; set tempc "" 162 set day1 ""; set day2 ""; set day3 ""; set day4 ""; set day5 ""; set state_name "" 163 set day6 ""; set day7 ""; set day8 ""; set day9 ""; set day10 ""; set windgust ""; set feelsfc "" 164 set wundergroundurl "/cgi-bin/findweather/hdfForecast?query=[urlencode $search]" 165 set wundergroundsite "www.wunderground.com" 166 if {"wz" == $command} {set command weather} 167 if {[catch {set wundergroundsock [socket -async $wundergroundsite 80]} sockerr]} { 168 return 0 169 } else { 170 puts $wundergroundsock "GET $wundergroundurl HTTP/1.0" 171 puts $wundergroundsock "Host: $wundergroundsite" 172 puts $wundergroundsock "User-Agent: Opera 9.6" 173 puts $wundergroundsock "" 174 flush $wundergroundsock 175 while {![eof $wundergroundsock]} { 176 set wundergroundvar " [gets $wundergroundsock] " 177 regexp -nocase {"(current)_observation":} $wundergroundvar match div 178 regexp -nocase {"(forecast)":} $wundergroundvar match div 179 regexp -nocase {"(astronomy)":} $wundergroundvar match div 180 if {[regexp -nocase {"city":"([^"]*)} $wundergroundvar match city]} { 181 if {$city == "null"} { 182 set city "" 183 } 184 } elseif {[regexp -nocase {"state_name":"([^"]*)} $wundergroundvar match state_name]} { 185 if {$state_name == "null"} { 186 set state_name "" 187 } 188 set location "${wunderground::tagf}Location: ${wunderground::textf}${city}, $state_name" 189 } elseif {[regexp -nocase {"name":"([^"]*)} $wundergroundvar match weatherstation]} { 190 set weatherstation "${wunderground::tagf}Station: ${wunderground::textf}${weatherstation}" 191 } elseif {$forc == "" && [regexp -nocase {class="wx-unit"> °(.*?)<\/span>} $wundergroundvar match forc]} { 192 } elseif {[regexp -nocase {"condition":"([^"]*)} $wundergroundvar match conditions]} { 193 set conditions "${wunderground::tagf}Conditions: ${wunderground::textf}${conditions}" 194 } elseif {$div == "current" && [regexp -nocase {"temperature":\s([^\,]*)} $wundergroundvar match temperature]} { 195 set tempf "${wunderground::tagf}Temperature: ${wunderground::textf}[forc ${temperature} $forc F] deg F" 196 set tempc "${wunderground::tagf}Temperature: ${wunderground::textf}[forc ${temperature} $forc C] deg C" 197 set tempfc "${wunderground::tagf}Temperature: ${wunderground::textf}[forc ${temperature} $forc F] deg F/[forc ${temperature} $forc C] deg C" 198 } elseif {$div == "current" && [regexp -nocase {"feelslike":\s([^\,]*)} $wundergroundvar match feelslike]} { 199 set feelsf "${wunderground::tagf}Feels Like: ${wunderground::textf}[forc ${feelslike} $forc F] deg F" 200 set feelsc "${wunderground::tagf}Feels Like: ${wunderground::textf}[forc ${feelslike} $forc C] deg C" 201 set feelsfc "${wunderground::tagf}Feels Like: ${wunderground::textf}[forc ${feelslike} $forc F] deg F/[forc ${feelslike} $forc C] deg C" 202 } elseif {$div == "current" && [regexp -nocase {"wind_speed":\s?([^\,]*)} $wundergroundvar match windspeed]} { 203 set windspeed "${wunderground::tagf}Wind speed: ${wunderground::textf}${windspeed}" 204 } elseif {$div == "current" && [regexp -nocase {"wind_gust_speed":\s?([^\,]*)} $wundergroundvar match windgust]} { 205 set windgust "${wunderground::tagf}Wind gust: ${wunderground::textf}${windgust}" 206 } elseif {[regexp -nocase {"wind_dir":"([^"]*)} $wundergroundvar match winddirection]} { 207 set winddirection "${wunderground::tagf}Wind Direction: ${wunderground::textf}${winddirection}" 208 } elseif {[regexp -nocase {id="cc-sun-rise">(.*?)</span>\s?<span class="ampm">(.*?)</span>} $wundergroundvar match sunrise ampm]} { 209 set sunrise "${wunderground::tagf}Sunrise: ${wunderground::textf}${sunrise}${ampm}" 210 } elseif {[regexp -nocase {id="cc-sun-set">(.*?)</span> <span class="ampm">(.*?)</span>} $wundergroundvar match sunset ampm]} { 211 set sunset "${wunderground::tagf}Sunset: ${wunderground::textf}${sunset}${ampm}" 212 } elseif {[regexp -nocase {id="cc-moon-phase".*">(.+?)<\/span>} $wundergroundvar match moon]} { 213 set moon "${wunderground::tagf}Moon: ${wunderground::textf}${moon}" 214 } elseif {$div == "forecast" && $command == "weather"} { 215 msg $chan $wunderground::logo ${wunderground::textf} [subst [regsub -all -nocase {(\S+)} $wunderground::weatherline {$\1}]] 216 close $wundergroundsock 217 return 0 218 } elseif {[regexp -nocase {<div\sclass="fctDayDate">(.+)\,} $wundergroundvar match day]} { 219 set day "${wunderground::tagf}${day}" 220 } elseif {[string match "forecast" $div]} { 221 if {[regexp -nocase {"weekday_short":\s?"([^"]*)} $wundergroundvar match day]} { 222 set day "${wunderground::tagf}${day}:->" 223 } elseif {[regexp -nocase {"high":\s([^\,]*)} $wundergroundvar match high]} { 224 set high "${wunderground::tagf}High:${wunderground::textf}[forc $high $forc F] deg F/[forc $high $forc C] deg C" 225 } elseif {[regexp -nocase {"low":\s([^\,]*)} $wundergroundvar match low]} { 226 set low "${wunderground::tagf}low:${wunderground::textf}[forc $low $forc F] deg F/[forc $low $forc C] deg C" 227 } elseif {[regexp -nocase {"condition":\s?"([^"]*)} $wundergroundvar match condition]} { 228 set condition "${wunderground::tagf}Cond:${wunderground::textf}${condition}" 229 } elseif {[regexp -nocase {"day":\s?\{} $wundergroundvar]} { 230 set day${count} "$day $high $low $condition" 231 incr count 232 } 233 } elseif {$div == "astronomy"} { 234 if {$wunderground::line1 != ""} { 235 msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line1 {$\1}]] 236 } 237 if {$wunderground::line2 != ""} { 238 msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line2 {$\1}]] 239 } 240 if {$wunderground::line3 != ""} { 241 msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line3 {$\1}]] 242 } 243 if {$wunderground::line4 != ""} { 244 msg $chan $wunderground::logo $wunderground::textf [subst [regsub -all -nocase {(\S+)} $wunderground::line4 {$\1}]] 245 } 246 close $wundergroundsock 247 return 0 248 } 249 } 250 } 251 } 252 proc wunderground::forc {value fc forc} { 253 if {[string equal -nocase $fc $forc]} { 254 return $value 255 } elseif {[string equal -nocase "f" $fc]} { 256 if {[expr {(($value - 32) * 5)} == 0]} { return 0 } 257 return [format "%.1f" [expr {(($value - 32) * 5) / 9}]] 258 } elseif {[string equal -nocase "c" $fc]} { 259 if {$value == 0} { return 32 } 260 return [format "%.1f" [expr {(($value * 9) / 5) + 32}]] 261 } 262 } 263 proc wunderground::striphtml {string} { 264 return [string map {" \" < < &rt; >} [regsub -all {(<[^<^>]*>)} $string ""]] 265 } 266 proc wunderground::urlencode {string} { 267 regsub -all {^\{|\}$} $string "" string 268 return [subst [regsub -nocase -all {([^a-z0-9\+])} $string {%[format %x [scan "\\&" %c]]}]] 269 } 270 proc wunderground::strip {text} { 271 regsub -all {\002|\031|\015|\037|\017|\003(\d{1,2})?(,\d{1,2})?} $text "" text 272 return $text 273 } 274 proc wunderground::msg {chan logo textf text} { 275 set text [textsplit $text 50] 276 set counter 0 277 while {$counter <= [llength $text]} { 278 if {[lindex $text $counter] != ""} { 279 % privmsg [tnda get "weatherserv/[curctx net]/ourid"] $chan "${logo} ${textf}[string map {\\\" \"} [lindex $text $counter]]" 280 } 281 incr counter 282 } 283 } 284 proc wunderground::textsplit {text limit} { 285 set text [split $text " "] 286 set tokens [llength $text] 287 set start 0 288 set return "" 289 while {[llength [lrange $text $start $tokens]] > $limit} { 290 incr tokens -1 291 if {[llength [lrange $text $start $tokens]] <= $limit} { 292 lappend return [join [lrange $text $start $tokens]] 293 set start [expr $tokens + 1] 294 set tokens [llength $text] 295 } 296 } 297 lappend return [join [lrange $text $start $tokens]] 298 return $return 299 } 300 puts stdout "\002*Loaded* \00304\002W\00304u\00307n\00308d\00311e\00312r\00304g\00307r\00308o\00311u\00312n\00304d\017 \002by \ 301 Ford_Lawnmower irc.GeekShed.net #Script-Help"