view weather.tcl @ 698:6ba9f961e463 default tip

quotedb: Bump version and copyright.
author Matti Hamalainen <ccr@tnsp.org>
date Mon, 18 Sep 2023 11:38:41 +0300
parents e1aba44b8c7b
children
line wrap: on
line source

##########################################################################
#
# Weather v2.2.0 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
# (C) Copyright 2014-2023 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.2.0 (C) 2014-2023 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 4]
        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(c_lat) [lindex $udata 1]
  set uvals(c_lng) [lindex $udata 2]
  set uvals(vtime) [lindex $udata 3]
  set uvals(temp) [lindex $udata 4]
  set uvals(humidity) [lindex $udata 5]
  set uvals(wind_speed) [lindex $udata 6]
  set uvals(wind_direction) [weather_get_wind_direction [lindex $udata 7]]
  set uvals(wind_direction_deg) [lindex $udata 7]
  set uvals(cloudiness) [weather_get_table_value $weather_msg_cloudiness [lindex $udata 8]]
  set uvals(cloudiness_val) [weather_get_raw_table_value $weather_msg_cloudiness [lindex $udata 8]]
  set uvals(road_surface_temp) [lindex $udata 9]
  set uvals(precipitation) [lindex $udata 10]
  set uvals(visibility) [lindex $udata 11]
  set uvals(precipitation2) [weather_get_table_value $weather_msg_precipitation [lindex $udata 12]]
  set uvals(precipitation_val) [weather_get_raw_table_value $weather_msg_precipitation [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)"]
  }

  # 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 max_matches 10
      set res [join [lrange $result 0 $max_matches] " ; "]
      if {[llength $result] > $max_matches} {
        append res [weather_qm "stations_limit" $max_matches]
      }
    } 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