Mercurial > hg > egg-tcls
view weather.tcl @ 523:89aaf279c12b
feeds: Bump copyrights.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Tue, 07 Jul 2020 12:04:12 +0300 |
parents | 3da1d036ae48 |
children | edbc0190e82a |
line wrap: on
line source
########################################################################## # # Weather v1.2.0 by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2014-2020 Tecnic Software productions (TNSP) # # Requires data fetcher to be run as a cronjob, see fetch_weather.pl # for more information. # # This script is freely distributable under GNU GPL (version 2) license. # ########################################################################## ### The configuration should be in config.weather in same directory ### as this script. Or change the line below to point where ever ### you wish. See "config.weather.example" for an example config file. source [file dirname [info script]]/config.weather ### Required utillib.tcl source [file dirname [info script]]/utillib.tcl ########################################################################## # No need to look below this line ########################################################################## set weather_name "Weather" set weather_version "1.2.0" ### Initialization messages package require textutil::split set weather_message "$weather_name v$weather_version (C) 2014-2020 ccr/TNSP" putlog "$weather_message" #------------------------------------------------------------------------- proc weather_log {arg} { global weather_logmsg weather_name if {$weather_logmsg != 0} { putlog "$weather_name: $arg" } } proc weather_msg {apublic anick achan amsg {aargs {}}} { global weather_preferredmsg set narg 1 foreach marg $aargs { set amsg [string map [list "%$narg" $marg] $amsg] incr narg } utl_msg_do $weather_preferredmsg $apublic $anick $achan $amsg } proc weather_usage {apublic anick achan amsg} { global weather_msg_usage_prefix_1 weather_msg_usage_prefix_2 global weather_preferredmsg set nline 0 foreach aline [split $amsg "\n"] { if {[string range $aline 0 1] == ":"} { utl_msg_do $weather_preferredmsg $apublic $anick $achan $aline } elseif {$nline == 0} { utl_msg_do $weather_preferredmsg $apublic $anick $achan "$weather_msg_usage_prefix_1$aline" } else { utl_msg_do $weather_preferredmsg $apublic $anick $achan "$weather_msg_usage_prefix_2$aline" } incr nline } } proc weather_valid_user {uhand} { if {$uhand != "" && $uhand != "{}" && $uhand != "*"} { return 1 } return 0 } #------------------------------------------------------------------------- proc weather_load_aliases {} { global weather_aliasfile weather_aliases # Create dict array unset weather_aliases array set weather_aliases {} # Read datafile if {![catch {set ufile [open $weather_aliasfile r 0600]} uerrmsg]} { while {![eof $ufile]} { gets $ufile uline set udata [split $uline "|"] if {[llength $udata] == 2} { set weather_aliases([lindex $udata 0]) [lindex $udata 1] } } close $ufile } else { weather_log "Could not open data file: $uerrmsg" } } proc weather_save_aliases {} { global weather_aliasfile weather_aliases if {![catch {set ufile [open $weather_aliasfile w 0600]} uerrmsg]} { foreach {ukey uvalue} [array get weather_aliases] { puts $ufile "$ukey|$uvalue" } close $ufile } else { weather_log "Could not open data file: $uerrmsg" } } # If there exists an alias for given string/name, return it proc weather_get_alias {uname} { global weather_aliases set utmp [array get weather_aliases $uname] if {[llength $utmp] > 0} { return [lindex $utmp 1] } return $uname } # Translate wind direction compass degree to name proc weather_get_wind_direction {uangle} { global weather_msg_wind_directions # If the data was not got, return empty value if {$uangle == ""} { return "" } # Calculate index to array of 8 compass direction names based on the angle we have set uvalue [expr int(floor(fmod($uangle + 45.0/2, 360.0) / 45.0))] if {$uvalue >= 0 && $uvalue < [llength $weather_msg_wind_directions]} { return [lindex $weather_msg_wind_directions $uvalue] } else { return "ERROR ($udir)" } } proc weather_get_raw_table_value {utable uvalue} { # If the data was not got, return empty value if {$uvalue == "" || $uvalue == "NaN"} { return "" } return "[expr int($uvalue) + 1]/[llength $utable]" } # "Translate" a straight table index (0-N) to table value proc weather_get_table_value {utable uvalue} { # If the data was not got, return empty value if {$uvalue == "" || $uvalue == "NaN"} { return "" } set uvalue [expr int($uvalue)] set ulen [llength $utable] if {$uvalue >= 0 && $uvalue < $ulen} { return [lindex $utable $uvalue] } else { return "ERROR ($uvalue)" } } #------------------------------------------------------------------------- # Produce one location of weather data as a string proc weather_get_str {udata umsg} { global weather_msg_cloudiness array unset uvals set uvals(station) [lindex $udata 0] set uvals(type) [lindex $udata 1] set uvals(c_lat) [lindex $udata 2] set uvals(c_lng) [lindex $udata 3] set uvals(c_height) [lindex $udata 4] set uvals(vtime) [lindex $udata 5] set uvals(temp) [lindex $udata 6] set uvals(humidity) [lindex $udata 7] set uvals(wind_speed) [lindex $udata 8] set uvals(wind_direction) [weather_get_wind_direction [lindex $udata 9]] set uvals(wind_direction_deg) [lindex $udata 9] set uvals(cloudiness) [weather_get_table_value $weather_msg_cloudiness [lindex $udata 10]] set uvals(cloudiness_val) [weather_get_raw_table_value $weather_msg_cloudiness [lindex $udata 10]] set uvals(road_surface_temp) [lindex $udata 11] set uvals(precipitation) [lindex $udata 12] set uvals(visibility) [lindex $udata 13] if {[expr [clock seconds] - $uvals(vtime)] < 3600} { set uvals(ctime) [clock format $uvals(vtime) -format "%H:%M"] } else { set uvals(ctime) [clock format $uvals(vtime) -format "%H:%M (%d.%m.%Y)"] } set astr "" foreach aitem $umsg { set atmp $aitem foreach {akey aval} [array get uvals] { if {$aval != ""} { set atmp [string map [list "@${akey}@" $aval] $atmp] } } if {$atmp != $aitem || [string first "@" $aitem] < 0} { append astr $atmp } } return $astr } # Get data by location key proc weather_get_by_key {ukey} { global weather_data weather_msg_result return [weather_get_str $weather_data($ukey) $weather_msg_result] } #------------------------------------------------------------------------- proc weather_update {} { global weather_datafile weather_data # Check if we can open the weather data file if {![catch {set ufile [open $weather_datafile r 0600]} uerrmsg]} { # Create dict array unset weather_data array set weather_data {} set wtemp_min_val 500000 set wtemp_max_val -500000 set wtemp_min_key "" set wtemp_max_key "" # Read in the data while {![eof $ufile]} { gets $ufile uline set udata [split $uline "|"] if {[llength $udata] > 0} { set utemp [lindex $udata 6] set ukey [lindex $udata 0] set weather_data($ukey) $udata if {[string is double -strict $utemp]} { if {$utemp < $wtemp_min_val} { set wtemp_min_key $ukey set wtemp_min_val $utemp } if {$utemp > $wtemp_max_val} { set wtemp_max_key $ukey set wtemp_max_val $utemp } } } } close $ufile # Store min/max if {$wtemp_min_key != "" && $wtemp_max_key != ""} { set weather_data(w_min) $weather_data($wtemp_min_key) set weather_data(w_max) $weather_data($wtemp_max_key) } else { set weather_data(w_min) 0 set weather_data(w_max) 0 } } else { weather_log "Could not open data file: $uerrmsg" } } #------------------------------------------------------------------------- # Weather data update loop proc weather_exec {} { global weather_check_period weather_running # Perform update weather_update # Schedule next update set weather_running [clock seconds] timer $weather_check_period weather_exec } #------------------------------------------------------------------------- # Script initialization #------------------------------------------------------------------------- if {![info exists weather_data]} { array set weather_data {} } if {![info exists weather_aliases]} { array set weather_aliases {} } if {[info exists weather_running]} { set weather_last [expr [clock seconds] - $weather_running] } else { set weather_last -1 } weather_log "Loading aliases." weather_load_aliases if {$weather_last < 0 || $weather_last > [expr $weather_check_period * 60]} { weather_log "Starting weather update timer." weather_exec } else { weather_log "Continuing weather updates." weather_update } #------------------------------------------------------------------------- proc weather_cmd {unick uhand uchan uargs upublic} { global weather_default_locations weather_data weather_max_results weather_aliases global weather_msg_usage_full weather_msg_usage_def_set weather_msg_user_not_known global weather_msg_no_results weather_msg_no_data_for_location global weather_msg_usage_alias weather_msg_usage_unalias weather_msg_defloc global weather_msg_aliased weather_msg_unaliased weather_msg_no_access global weather_msg_def_set weather_msg_def_not_set weather_msg_aliases global weather_msg_usage_stations weather_msg_stations weather_msg_list_station global weather_msg_list_nearest weather_msg_usage_nearest weather_msg_usage_nearest_invalid global weather_msg_nearest_stations weather_msg_result # Check and handle arguments set rarglist [::textutil::split::splitx $uargs {\s+}] set rcmd [lindex $rarglist 0] if {$rcmd == "?" || $rcmd == "help" || $rcmd == "apua"} { weather_usage $upublic $unick $uchan $weather_msg_usage_full return 0 } if {$rcmd == "asemat" || $rcmd == "stations"} { # List stations/locations matching the given pattern if {[llength $rarglist] < 2} { weather_usage $upublic $unick $uchan $weather_msg_usage_stations return 0 } set rmatch [join [lrange $rarglist 1 end] " "] set result {} foreach {ukey uvalue} [array get weather_data] { if {![string match "w_*" $ukey] && [string match -nocase "*${rmatch}*" $ukey]} { lappend result [weather_get_str $uvalue $weather_msg_list_station] } } set res [join $result " ; "] weather_msg $upublic $unick $uchan $weather_msg_stations [list $res] return 0 } elseif {$rcmd == "lahin" || $rcmd == "lähin" || $rcmd == "closest" || $rcmd == "nearest"} { # List stations nearest to given coordinates set qargs [join [lrange $rarglist 1 end] ""] if {![regexp {@?(\d+|\d+\.\d+|\.\d+)\s*,\s*(\d+|\d+\.\d+|\.\d+)} $qargs -> d_lat d_lng]} { weather_usage $upublic $unick $uchan $weather_msg_usage_nearest return 0 } # Check argument types if {![string is double -strict $d_lat] || ![string is double -strict $d_lng]} { weather_msg $upublic $unick $uchan $weather_msg_usage_nearest_invalid return 0 } # Calculate distances between given coordinates for each location set result {} foreach {ukey uvalue} [array get weather_data] { if {![string match "w_*" $ukey]} { set delta_lat [expr {$d_lat - [lindex $uvalue 2]}] set delta_lng [expr {$d_lng - [lindex $uvalue 3]}] set dist [expr { sqrt($delta_lat * $delta_lat + $delta_lng * $delta_lng) }] lappend result [list $ukey $dist] } } # Sort the list by distance set usorted [lsort -real -index 1 $result] # Create a result list for few best/first matches set uresult {} foreach {uval} [lrange $usorted 0 2] { lappend uresult [weather_get_str $weather_data([lindex $uval 0]) $weather_msg_list_nearest] } # Print out the result set res [join $uresult " ; "] weather_msg $upublic $unick $uchan $weather_msg_nearest_stations [list $d_lat $d_lng $res] return 0 } elseif {$rcmd == "vakio" || $rcmd == "default" || $rcmd == "vakiot" || $rcmd == "defaults"} { # List or set the default weather station name patterns for this user # Access check if {![weather_valid_user $uhand]} { weather_msg $upublic $unick $uchan $weather_msg_user_not_known return 0 } if {[llength $rarglist] == 1} { set lista [getuser $uhand XTRA "weather_locations"] if {$lista == "" || $lista == "{}"} { weather_msg $upublic $unick $uchan $weather_msg_def_not_set [list $uhand] } else { set lista [join [split $lista ";"] " ; "] weather_msg $upublic $unick $uchan $weather_msg_defloc [list $uhand $lista] } } else { # Split the list of desired locations set qlist [::textutil::split::splitx [join [lrange $rarglist 1 end] " "] {\s*\;\s*}] set nlist [lsearch -all -inline -not -exact $qlist ""] if {[llength $nlist] > 0} { weather_msg $upublic $unick $uchan $weather_msg_def_set [list [join $nlist " ; "]] setuser $uhand XTRA "weather_locations" [join $nlist ";"] } else { weather_usage $upublic $unick $uchan $weather_msg_usage_def_set } } return 0 } elseif {$rcmd == "alias"} { # Alias a string to another, only certain users have access (+n flag) if {![weather_valid_user $uhand] || ![matchattr $uhand n]} { weather_msg $upublic $unick $uchan $weather_msg_no_access return 0 } set qlist [::textutil::split::splitx [join [lrange $rarglist 1 end] " "] {\s*=\s*}] set nlist [lsearch -all -inline -not -exact $qlist ""] if {[llength $nlist] < 2} { weather_usage $upublic $unick $uchan $weather_msg_usage_alias return 0 } set ualias [lindex $nlist 0] set uname [lindex $nlist 1] set weather_aliases($ualias) $uname weather_msg $upublic $unick $uchan $weather_msg_aliased [list $ualias $uname] weather_save_aliases return 0 } elseif {$rcmd == "unalias"} { # Remove one alias, only certain users have access (+n flag) if {![weather_valid_user $uhand] || ![matchattr $uhand n]} { weather_msg $upublic $unick $uchan $weather_msg_no_access return 0 } if {[llength $rarglist] < 2} { weather_usage $upublic $unick $uchan $weather_msg_usage_unalias return 0 } set ualias [lindex $rarglist 1] unset weather_aliases($ualias) weather_msg $upublic $unick $uchan $weather_msg_unaliased [list $ualias] weather_save_aliases return 0 } elseif {$rcmd == "list"} { # List all currently defined aliases set ulist {} foreach {ukey uvalue} [array get weather_aliases] { lappend ulist "\002'$ukey' = '$uvalue'\002" } weather_msg $upublic $unick $uchan $weather_msg_aliases [list [join $ulist ", "]] return 0 } # Get args or default location(s) set rargs [join $rarglist " "] if {$rargs == "" && $uhand != "" && $uhand != "{}" && $uhand != "*"} { set rargs [getuser $uhand XTRA "weather_locations"] } if {$rargs == ""} { set rargs $weather_default_locations } # Handle argument list set nresults 0 set rarglist [::textutil::split::splitx $rargs "\s*\;\s*"] foreach rarg $rarglist { if {$rarg == "min"} { # Min temp set umin [weather_get_by_key "w_min"] weather_msg $upublic $unick $uchan "Min: $umin" incr nresults } elseif {$rarg == "max"} { # Max temp set umax [weather_get_by_key "w_max"] weather_msg $upublic $unick $uchan "Max: $umax" incr nresults } elseif {$rarg == "minmax" || $rarg == "min max" || $rarg == "maxmin" || $rarg == "max min"} { # Min & Max temps set umin [weather_get_by_key "w_min"] set umax [weather_get_by_key "w_max"] weather_msg $upublic $unick $uchan "Min: $umin | Max: $umax" incr nresults } else { # Location match set ufound 0 set rarg [weather_get_alias $rarg] foreach {ukey uvalue} [array get weather_data] { if {![string match "w_*" $ukey] && [string match -nocase "*${rarg}*" $ukey]} { if {[llength $uvalue] > 0} { weather_msg $upublic $unick $uchan [weather_get_str $uvalue $weather_msg_result] incr nresults } else { weather_msg $upublic $unick $uchan $weather_msg_no_results [list $ukey] } incr ufound } # Check for results limit if {$nresults >= $weather_max_results} { return 0 } } if {$ufound == 0} { weather_msg $upublic $unick $uchan $weather_msg_no_data_for_location [list $rarg] } } # Check for results limit if {$nresults >= $weather_max_results} { return 0 } } return 0 } #------------------------------------------------------------------------- proc weather_cmd_pub {unick uhost uhand uchan uargs} { global weather_channels if {[utl_match_delim_list $weather_channels $uchan]} { return [weather_cmd $unick $uhand $uchan $uargs 1] } return 0 } #------------------------------------------------------------------------- proc weather_cmd_msg {unick uhost uhand uargs} { return [weather_cmd $unick $uhand "PRIV" $uargs 0] } # end of script