Mercurial > hg > egg-tcls
view weather.tcl @ 687:7f1a0d25aa40
fetch_weather: Cleanups, fix counting of FMI stations.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Thu, 15 Jun 2023 13:25:32 +0300 |
parents | a09401d4ac8c |
children | 2723be85343a |
line wrap: on
line source
########################################################################## # # Weather v2.1.0 by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2014-2021 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 ########################################################################## package require textutil::split set weather_name "Weather" set weather_message "$weather_name v2.1.0 (C) 2014-2021 ccr/TNSP" #------------------------------------------------------------------------- ### Utility functions proc weather_log {umsg} { global weather_log_enable weather_name if {$weather_log_enable != 0} { putlog "${weather_name}: $umsg" } } proc weather_qm {uid} { global weather_messages if {[info exists weather_messages($uid)]} { return $weather_messages($uid) } else { return $uid } } proc weather_smsg {apublic anick achan amsg {aargs {}}} { global weather_preferredmsg weather_cmd_name set amsg [string map [list "@cmd@" $weather_cmd_name] $amsg] utl_msg_args $weather_preferredmsg $apublic $anick $achan $amsg $aargs } proc weather_msg {apublic anick achan aid {aargs {}}} { weather_smsg $apublic $anick $achan [weather_qm $aid] $aargs } #------------------------------------------------------------------------- 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 } #------------------------------------------------------------------------- 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 } #------------------------------------------------------------------------- # 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 global weather_msg_precipitation 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] set uvals(precipitation2) [weather_get_table_value $weather_msg_precipitation [lindex $udata 14]] set uvals(precipitation_val) [weather_get_raw_table_value $weather_msg_precipitation [lindex $udata 14]] 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)"] } # Kludge for always having a value for "temp" if {$uvals(temp) == ""} { set uvals(temp) "???" } set astr "" foreach aitem $umsg { set atmp $aitem set aok 1 # Map tokens to values if they are set foreach {akey aval} [array get uvals] { if {[string match "*@${akey}@*" $atmp]} { if {$aval != ""} { set atmp [string map [list "@${akey}@" $aval] $atmp] } else { set aok 0 } } } # Add item to string if all tokens in string were found if {$aok} { append astr $atmp } } return $astr } # Get data by location key proc weather_get_str_by_key {ukey} { global weather_data weather_msg_result return [weather_get_str $weather_data($ukey) $weather_msg_result] } proc weather_cmd_match { uid ustr } { global weather_commands return [utl_cmd_match weather_commands $uid $ustr] } #------------------------------------------------------------------------- proc weather_cmd {unick $uhost uhand uchan uargs upublic} { global weather_default_locations weather_data weather_max_results weather_aliases global weather_msg_list_station weather_msg_result weather_messages # Check and handle arguments set rarglist [::textutil::split::splitx $uargs {\s+}] set rcmd [lindex $rarglist 0] if {[weather_cmd_match "help" $rcmd]} { # Show help foreach ukey $weather_messages(help_full) { weather_msg $upublic $unick $uchan $ukey } return 1 } elseif {[weather_cmd_match "stations" $rcmd]} { # List stations/locations matching the given pattern if {[llength $rarglist] < 2} { weather_msg $upublic $unick $uchan "help_stations" return 1 } 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] } } if {[llength $result] > 0} { set res "" if {[llength $result] > 10} { set res [weather_qm "stations_limit"] } append res [join [lrange $result 0 10] " ; "] } else { set res [weather_qm "stations_no_matches"] } weather_msg $upublic $unick $uchan "stations_list" [list $res] return 1 } elseif {[weather_cmd_match "nearest" $rcmd]} { # 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_msg $upublic $unick $uchan "help_nearest" return 1 } # Check argument types if {![string is double -strict $d_lat] || ![string is double -strict $d_lng]} { weather_msg $upublic $unick $uchan "nearest_invalid" return 1 } # 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_station] } # Print out the result set res [join $uresult " ; "] weather_msg $upublic $unick $uchan "nearest_stations" [list $d_lat $d_lng $res] return 1 } elseif {[weather_cmd_match "default" $rcmd]} { # List or set the default weather station name patterns for this user # Access check if {![utl_valid_user $uhand]} { weather_msg $upublic $unick $uchan "user_not_known" return 1 } if {[llength $rarglist] == 1} { set lista [getuser $uhand XTRA "weather_locations"] if {$lista == "" || $lista == "{}"} { weather_msg $upublic $unick $uchan "def_not_set" [list $uhand] } else { set lista [join [split $lista ";"] " ; "] weather_msg $upublic $unick $uchan "def_value" [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 "def_set_to" [list [join $nlist " ; "]] setuser $uhand XTRA "weather_locations" [join $nlist ";"] } else { weather_msg $upublic $unick $uchan "help_def_set" } } return 1 } elseif {[weather_cmd_match "alias" $rcmd]} { # Alias a string to another, only certain users have access (+n flag) if {![utl_valid_user $uhand] || ![matchattr $uhand n]} { weather_msg $upublic $unick $uchan "no_access" return 1 } 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_msg $upublic $unick $uchan "help_alias" return 1 } set ualias [lindex $nlist 0] set uname [lindex $nlist 1] if {[info exists weather_aliases($ualias)]} { weather_msg $upublic $unick $uchan "alias_updated" [list $ualias $weather_aliases($ualias) $uname] } else { weather_msg $upublic $unick $uchan "alias_set" [list $ualias $uname] } set weather_aliases($ualias) $uname weather_save_aliases return 1 } elseif {[weather_cmd_match "unalias" $rcmd]} { # Remove one alias, only certain users have access (+n flag) if {![utl_valid_user $uhand] || ![matchattr $uhand n]} { weather_msg $upublic $unick $uchan "no_access" return 1 } if {[llength $rarglist] < 2} { weather_msg $upublic $unick $uchan "help_unalias" return 1 } set ualias [lindex $rarglist 1] if {![info exists weather_aliases($ualias)]} { weather_msg $upublic $unick $uchan "alias_not_exist" [list $ualias] return 1 } weather_msg $upublic $unick $uchan "alias_unset" [list $ualias $weather_aliases($ualias)] unset weather_aliases($ualias) weather_save_aliases return 1 } elseif {[weather_cmd_match "list" $rcmd]} { # List all currently defined aliases set ulist {} set ulistitem [weather_qm "alias_item"] set ulistsep [weather_qm "alias_list_sep"] foreach {ukey uvalue} [array get weather_aliases] { lappend ulist [utl_str_map_values $ulistitem [list $ukey $uvalue]] } weather_msg $upublic $unick $uchan "alias_list" [list [join $ulist $ulistsep]] return 1 } # 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 weather_msg $upublic $unick $uchan "temp_min" [list [weather_get_str_by_key "w_min"]] incr nresults } elseif {$rarg == "max"} { # Max temp weather_msg $upublic $unick $uchan "temp_max" [list [weather_get_str_by_key "w_max"]] incr nresults } elseif {$rarg == "minmax" || $rarg == "min max" || $rarg == "maxmin" || $rarg == "max min"} { # Min & Max temps weather_msg $upublic $unick $uchan "temp_minmax" [list [weather_get_str_by_key "w_min"] [weather_get_str_by_key "w_max"]] 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_smsg $upublic $unick $uchan [weather_get_str $uvalue $weather_msg_result] incr nresults } else { weather_msg $upublic $unick $uchan "no_results" [list $ukey] } incr ufound } # Check for results limit if {$nresults >= $weather_max_results} { return 1 } } if {$ufound == 0} { weather_msg $upublic $unick $uchan "no_data_for_location" [list $rarg] } } # Check for results limit if {$nresults >= $weather_max_results} { return 1 } } return 1 } #------------------------------------------------------------------------- proc weather_cmd_pub {unick uhost uhand uchan uargs} { global weather_channels if {[utl_match_delim_list $weather_channels $uchan]} { return [weather_cmd $unick $uhost $uhand $uchan $uargs 1] } return 0 } proc weather_cmd_msg {unick uhost uhand uargs} { return [weather_cmd $unick $uhost $uhand "PRIV" $uargs 0] } #------------------------------------------------------------------------- # Script initialization #------------------------------------------------------------------------- putlog "$weather_message" 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 } putlog " - Loading aliases." weather_load_aliases if {$weather_last < 0 || $weather_last > [expr $weather_check_period * 60]} { putlog " - Starting weather update timer." weather_exec } else { putlog " - Continuing weather updates." weather_update } # end of script