Mercurial > hg > egg-tcls
view weather.tcl @ 406:4c3abf052d01
fetch_weather: "use 5.018;" and some cleanups.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Sat, 07 Jan 2017 04:15:27 +0200 |
parents | 72b4e4f47af2 |
children | 8abbdee71cf5 |
line wrap: on
line source
########################################################################## # # Weather v0.9.3 by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2014-2015 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 "0.9.3" ### Initialization messages package require textutil::split set weather_message "$weather_name v$weather_version by 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_do {apublic anick achan amsg} { global weather_preferredmsg if {$apublic == 1} { putserv "$weather_preferredmsg $achan :$amsg" } else { putserv "$weather_preferredmsg $anick :$amsg" } } proc weather_msg {apublic anick achan amsg {aargs {}}} { set narg 1 foreach marg $aargs { set amsg [string map [list "%$narg" $marg] $amsg] incr narg } weather_msg_do $apublic $anick $achan $amsg } proc weather_usage {apublic anick achan amsg} { global weather_msg_usage_prefix_1 weather_msg_usage_prefix_2 set nline 0 foreach aline [split $amsg "\n"] { if {[string range $aline 0 1] == ":"} { weather_msg_do $apublic $anick $achan $aline } elseif {$nline == 0} { weather_msg_do $apublic $anick $achan "$weather_msg_usage_prefix_1$aline" } else { weather_msg_do $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 } #------------------------------------------------------------------------- # Produce one location of weather data as a string proc weather_get_data {udata ukey} { global weather_msg_result # Set data to array array unset uvals set uvals(station) [lindex $udata 0] set uvals(type) [lindex $udata 1] set uvals(vtime) [lindex $udata 2] 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 uvals(temp) [lindex $udata 3] if {[lindex $udata 1] == 0} { set uvals(weather1) [lindex $udata 5] set uvals(weather2) [lindex $udata 6] set uvals(road_temp) [lindex $udata 4] } else { set uvals(humidity) [lindex $udata 4] set uvals(wind_speed) [lindex $udata 5] set uvals(cloud_cover) [lindex $udata 6] } # Transform the format list set astr "" foreach aitem $weather_msg_result { set atmp $aitem foreach {akey aval} [array get uvals] { if {$aval != ""} { set atmp [string map [list "@${akey}@" $aval] $atmp] } } if {$atmp != $aitem} { append astr $atmp } } return "$astr." } # Get data by location key proc weather_get_by_key {ukey} { global weather_data return [weather_get_data $weather_data($ukey) $ukey] } #------------------------------------------------------------------------- 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 3] 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 # Check and handle arguments set rarglist [::textutil::split::splitx $uargs {\s+}] set rarg [lindex $rarglist 0] if {$rarg == "?" || $rarg == "help" || $rarg == "apua"} { weather_usage $upublic $unick $uchan "$weather_msg_usage_full" return 0 } if {$rarg == "asemat" || $rarg == "stations"} { # List stations/locations matching the given pattern if {[llength $rarglist] < 2} { weather_usage $upublic $unick $uchan $weather_msg_usage_stations return 0 } set rarg [join [lrange $rarglist 1 end] " "] set result {} foreach {ukey uvalue} [array get weather_data] { if {![string match "w_*" $ukey] && [string match -nocase "*${rarg}*" $ukey]} { lappend result $ukey } } set res [join $result " ; "] weather_msg $upublic $unick $uchan $weather_msg_stations [list $res] return 0 } elseif {$rarg == "vakio" || $rarg == "default" || $rarg == "vakiot" || $rarg == "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 {$rarg == "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 {$rarg == "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 {$rarg == "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_data $uvalue $ukey] 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