view weather.tcl @ 415:ff932030a9b3

weather: Bump version.
author Matti Hamalainen <ccr@tnsp.org>
date Sat, 07 Jan 2017 22:41:07 +0200
parents d623652df6b5
children e904b453a06a
line wrap: on
line source

##########################################################################
#
# Weather v0.9.5 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
# (C) Copyright 2014-2017 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.5"


### 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(c_lat) [lindex $udata 2]
  set uvals(c_long) [lindex $udata 3]
  set uvals(c_height) [lindex $udata 4]
  set uvals(vtime) [lindex $udata 5]

  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 6]

  if {[lindex $udata 1] == 0} {
    set uvals(road_temp) [lindex $udata 7]
    set uvals(weather1) [lindex $udata 8]
    set uvals(weather2) [lindex $udata 9]
  } else {
    set uvals(humidity) [lindex $udata 7]
    set uvals(wind_speed) [lindex $udata 8]
    set uvals(cloud_cover) [lindex $udata 9]
  }

  # 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 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

  # 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