Mercurial > hg > egg-tcls
view weather.tcl @ 218:861a49abee22
Bump versions.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Mon, 29 Sep 2014 05:49:22 +0300 |
parents | 67018e353536 |
children | 03579553233b |
line wrap: on
line source
########################################################################## # # Weather v0.7 by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2014 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. # ########################################################################## # Default location if none given and none set by user. # Multiple can be specified as "foo;bar;etc" set weather_default_locations "raahe" # Weather data file, must match the one in fetch_weather.pl's config set weather_datafile "/home/niinuska/bot/weather.data" # Alias data file set weather_aliasfile "/home/niinuska/bot/weather.alias" # How often to check the weather data file for updates (in minutes) set weather_check_period 2 # Max number of results to be listed set weather_max_results 3 # ... set weather_logmsg 1 set weather_preferredmsg "PRIVMSG" ### ### Messages ### set weather_msg_usage_prefix_1 "Käyttö: !sää " set weather_msg_usage_prefix_2 " !sää " set weather_msg_usage_def_set "vakio <paikka>\[;<paikka2>\] -- asettaa vakiohavaintoaseman\nvakio -- näyttää nykyisen" set weather_msg_usage_alias "alias <alias> = <nimi> (Lisää alias-nimen, esim. alias perse = turku)" set weather_msg_usage_unalias "unalias <alias> (Poistaa aliaksen)" set weather_msg_usage_stations "asemat <patterni> -- listaa mittausasemat joiden nimi matsaa patternin kanssa" set weather_msg_usage_full "\[paikka\]\n$weather_msg_usage_def_set\n$weather_msg_usage_alias\n$weather_msg_usage_unalias\n$weather_msg_usage_stations" set weather_msg_def_set "Vakio-havaintoasemiksi asetettu: \002%1\002." set weather_msg_defloc "Käyttäjän \002%1\002 vakio-havaintoasemat ovat: \002%2\002." set weather_msg_def_not_set "Vakio-havaintoasemia ei asetettu käyttäjälle \002%1\002." set weather_msg_aliased "Aliasoitiin \002%1\002 = \002%2\002." set weather_msg_unaliased "Unaliasoitiin \002%1\002." set weather_msg_aliases "Aliakset: %1" set weather_msg_user_not_known "Tuntematon käyttäjä." set weather_msg_no_access "Ei oikeuksia muuttaa asetuksia." set weather_msg_stations "Mittausasemat: %1" set weather_msg_no_results "\002%1\002: Ei mittaustietoja." set weather_msg_no_data_for_location "\002%1\002: Paikkakunnan tietoja ei saatu." ########################################################################## # No need to look below this line ########################################################################## set weather_name "Weather" set weather_version "0.7" ### Binding initializations bind pub - !sää weather_cmd_pub bind pub - !saa weather_cmd_pub bind msg - !sää weather_cmd_msg bind msg - !saa weather_cmd_msg ### 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_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_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_ctime {utime} { return [clock format $utime -format "%H:%M"] } 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 } #------------------------------------------------------------------------- proc weather_item {udata uindex ufmt} { if {[llength $udata] > $uindex && [lindex $udata $uindex] != ""} { set utmp [lindex $udata $uindex] return [string map [list "@@" $utmp] $ufmt] } return "" } # Produce one location of weather data as a string proc weather_get_data {ukey udata} { set str "\002[lindex $udata 0]\002, mitattu klo [weather_ctime [lindex $udata 2]]: \002[lindex $udata 3]°C\002" append str [weather_item $udata 5 ", @@"] append str [weather_item $udata 6 ", kosteus \002@@%\002"] append str [weather_item $udata 7 ", keli @@"] append str [weather_item $udata 4 ", tien pinta @@°C"] return "${str}." } # Get data by location key proc weather_get_key {ukey} { global weather_data return [weather_get_data $ukey $weather_data($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 set weather_data(w_min) $weather_data($wtemp_min_key) set weather_data(w_max) $weather_data($wtemp_max_key) } 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." weather_exec } else { 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"} { # 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_key "w_min"] weather_msg $upublic $unick $uchan "Min: $umin" incr nresults } elseif {$rarg == "max"} { # Max temp set umax [weather_get_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_key "w_min"] set umax [weather_get_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 $ukey $uvalue] 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} { return [weather_cmd $unick $uhand $uchan $uargs 1] } #------------------------------------------------------------------------- proc weather_cmd_msg {unick uhost uhand uargs} { return [weather_cmd $unick $uhand "PRIV" $uargs 0] } # end of script