view tj.tcl @ 678:7ff41e458ee0

tj: Fix future TJ date displays.
author Matti Hamalainen <ccr@tnsp.org>
date Sun, 04 Apr 2021 23:38:13 +0300
parents 4156adacdc31
children 299a17b98f84
line wrap: on
line source

##########################################################################
#
# TJ v2.0 by ccr/TNSP <ccr@tnsp.org>
# (C) Copyright 2021 Tecnic Software productions (TNSP)
#
# This script is freely distributable under GNU GPL (version 2) license.
#
##########################################################################

### The configuration should be in config.tj in same directory
### as this script. Or change the line below to point where ever
### you wish. See "config.tj.example" for an example config file.
source [file dirname [info script]]/config.tj

### Required utillib.tcl
source [file dirname [info script]]/utillib.tcl


##########################################################################
# No need to look below this line
##########################################################################
package require sqlite3
package require textutil::split

set tj_name "TJ"
set tj_message "$tj_name v2.0 (C) 2021 ccr/TNSP"


# ------------------------------------------------------------------------
### Utility functions
proc tj_log {umsg} {
  global tj_log_enable tj_name
  if {$tj_log_enable != 0} {
    putlog "${tj_name}: $umsg"
  }
}


proc tj_qm {uid} {
  global tj_messages

  if {[info exists tj_messages($uid)]} {
    return $tj_messages($uid)
  } else {
    return $uid
  }
}


proc tj_smsg {apublic anick achan amsg {aargs {}}} {
  global tj_preferredmsg tj_cmd_name
  set amsg [string map [list "@cmd@" $tj_cmd_name] $amsg]
  utl_msg_args $tj_preferredmsg $apublic $anick $achan $amsg $aargs
}


proc tj_msg {apublic anick achan aid {aargs {}}} {
  tj_smsg $apublic $anick $achan [tj_qm $aid] $aargs
}


proc tj_correct_handle {uhand} {
  set ulower [string tolower $uhand]
  foreach uuser [userlist] {
    if {[string tolower $uuser] == $ulower} {
      return $uuser
    }
  }
  return ""
}


proc tj_cmd_match {uid ustr} {
  global tj_commands
  return [utl_cmd_match tj_commands $uid $ustr]
}


# ------------------------------------------------------------------------
proc tj_get_id {rstr rindex rid} {
  upvar $rindex uindex
  upvar $rid uid

  if {[string index $rstr 0] == "#"} {
    set uid [string range $rstr 1 end]
    incr uindex
    return 1
  } else {
    return 0
  }
}


proc tj_get_default_id {uhand} {
  global tj_default_id

  set uid [getuser $uhand XTRA "tj_default_id"]
  if {$uid == "" || $uid == "{}" || $uid == "*"} {
    return $tj_default_id
  } else {
    return $uid
  }
}


proc tj_ctime {ustamp} {
  return [clock format $ustamp -format [tj_qm "datefmt_long"]]
}


proc tj_ctimes {ustamp} {
  return [clock format $ustamp -format [tj_qm "datefmt_short"]]
}


# ------------------------------------------------------------------------
proc tj_str_append { qlist qvalue qsingular qplural } {
  upvar $qlist ulist
  if {$qvalue > 0} {
    if {$qvalue > 1} {
      set qfmt $qplural
    } else {
      set qfmt $qsingular
    }
    lappend ulist [utl_str_map_values [tj_qm "tj_str_${qfmt}"] [list $qvalue]]
  }
}


# Return string describing how many years,days,hours,etc
# the given number of seconds consists of
proc tj_get_tj_str {useconds} {

  set uyears [expr ($useconds / (365*24*60*60))]
  set urem [expr ($useconds % (365*24*60*60))]
  set udays [expr ($urem / (24*60*60))]
  set urem [expr ($urem % (24*60*60))]
  set uhours [expr ($urem / (60*60))]
  set urem [expr ($urem % (60*60))]
  set uminutes [expr ($urem / 60)]

  set ulist {}
  tj_str_append ulist $uyears "year" "years"
  tj_str_append ulist $udays "day" "days"
  tj_str_append ulist $uhours "hour" "hours"
  tj_str_append ulist $uminutes "minute" "minutes"

  set ustr [join [lrange $ulist 0 end-1] [tj_qm "tj_str_sep"]]
  if {[llength $ulist] > 1} {
    append ustr [tj_qm "tj_str_sep_last"]
  }
  append ustr [lindex $ulist end]

  return $ustr
}


proc tj_get_tj_str_delta {ustamp uclock} {
  set udelta [expr $ustamp - $uclock]

  if {$udelta < 0} {
    set ufmt "tjs_past"
    set useconds [expr -$udelta]
  } else {
    set ufmt "tjs_future"
    set useconds $udelta
  }

  return [utl_str_map_values [tj_qm $ufmt] [list [tj_get_tj_str $useconds] [tj_ctime $ustamp]]]
}


# ------------------------------------------------------------------------
proc tj_display_tjs {upublic unick uchan uname uid uclock} {

  set nresults 0
  set usql "SELECT * FROM tj WHERE uuser='[utl_escape $uname]' AND utype=0 AND uid LIKE '[utl_escape $uid]'"
  tj_dbh eval $usql {
    incr nresults
    set ustamp [utl_sql_datetime_to_stamp $utarget]
    set udelta [expr $ustamp - $uclock]

    if {$udelta < 0} {
      set ufmt "tj_past"
      set useconds [expr -$udelta]
    } else {
      set ufmt "tj_future"
      set useconds $udelta
    }

    tj_msg $upublic $unick $uchan $ufmt [list $uname $uid [tj_get_tj_str $useconds] [tj_ctime $ustamp]]
  }

  if {!$nresults} {
    tj_msg $upublic $unick $uchan "tj_not_set" [list $uname $uid]
  }
}


# ------------------------------------------------------------------------
proc tj_cmd {unick $uhost uhand uchan uargs upublic} {
  global tj_messages tj_default_id tj_default_time tj_default_desc tj_max_items

  # Check if we have a valid user
  if {![utl_valid_user $uhand]} {
    tj_msg $upublic $unick $uchan "err_invalid_user" [list $uhand]
    return 1
  }

  set uclock [clock seconds]
  set uhand [tj_correct_handle $uhand]
  set qadmin [matchattr $uhand n]

  # Check and handle arguments
  set rarglist [::textutil::split::splitx $uargs {\s+}]
  set rcmd [lindex $rarglist 0]
  set rindex 1

  if {[tj_cmd_match "help" $rcmd]} {
    # Show help
    foreach ukey $tj_messages(help_full) {
      tj_msg $upublic $unick $uchan $ukey
    }
    return 1
  } elseif {[tj_cmd_match "set" $rcmd]} {
    # !tj set [#<id>] <[-/+]days [[+/-]<hours>] | dd.mm.yyyy [hh:mm]> [<desc>]
    if {![utl_arg_get $rarglist rindex rarg 0]} {
      tj_msg $upublic $unick $uchan "help_set"
      return 1
    }

    # Check for #id prefix
    set rdesc "*"
    if {![tj_get_id $rarg rindex uid]} {
      set uid [tj_get_default_id $uhand]
    }

    # Do we have any arguments left?
    if {![utl_arg_get $rarglist rindex rarg 1]} {
      tj_msg $upublic $unick $uchan "help_set"
      return 1
    }

    # Is it a time stamp?
    if {[regexp {\d+\.\d+\.\d\d\d\d} $rarg rdate]} {
      # Seems so .. check for hours
      set rtime $tj_default_time
      if {[utl_arg_get $rarglist rindex rarg 0]} {
        if {[regexp {\d+:\d+} $rarg rtime]} {
          incr rindex
        } else {
          set rtime $tj_default_time
        }
      }

      utl_arg_rest $rarglist $rindex rdesc

      # Check the timestamp validity
      if {[catch {set rstamp [clock scan "${rdate} ${rtime}" -format "%d.%m.%Y %H:%M"]} uerrmsg]} {
        tj_msg $upublic $unick $uchan "err_timestamp" [list $uerrmsg $rdate $rtime]
        return 1
      }

    } elseif {[regexp {(\+|\-)?(\d+)} $rarg -> dsign rdays]} {
      # Check for days
      if {$dsign == "-"} { set rdays [expr -$rdays] }

      # Check for hours
      set rhours 0
      if {[utl_arg_get $rarglist rindex rarg 0]} {
        if {[regexp {(\+|\-)?(\d+)} $rarg -> hsign rhours]} {
          if {$hsign == "-"} { set rhours [expr -$rhours] }
          incr rindex
        }

        # Get description, if any
        utl_arg_rest $rarglist $rindex rdesc

        # Validate hours parameters a bit
        if {$rhours < -24 || $rhours > 24} {
          tj_msg $upublic $unick $uchan "err_invalid_hours" [list $rhours]
          return 1
        }
      }

      # Compute target timestamp
      set rstamp [expr $uclock + ($rdays * 24 * 60 * 60) + ($rhours * 60 * 60)]
    } else {
      # Only description was specified
      incr rindex -1
      utl_arg_rest $rarglist $rindex rdesc
      set rstamp "invalid"
    }

    # Check if ID exists
    set umode 1
    set nres 0
    set usql "SELECT * FROM tj WHERE uid LIKE '[utl_escape $uid]'"
    tj_dbh eval $usql {
      set umode 0
      set cid $id
      set ctarget $utarget

      # If description has not been set, fetch previous
      if {$rdesc == "*"} {
        set rdesc $udesc
      }
      incr nres
    }

    # Check for DB sanity at this point
    if {$nres > 1} {
      # If we have more than one result for this ID, there's been
      # some kind of mistake at some point.
      tj_msg $upublic $unick $uchan "err_db_corrupt" [list $nres]
      tj_log "too many $nres fatal error piip"
      return 1
    }

    # Check if we are trying to add a new entry without valid timestamp
    if {$rstamp == "invalid"} {
      # Yes, if mode is "new", we should error out
      if {$umode} {
        tj_msg $upublic $unick $uchan "err_missing_timestamp"
        return 1
      }

      # Otherwise we are updating, so just use the old timestamp
      set rdate $ctarget
      set ustamp [utl_sql_datetime_to_stamp $ctarget]
    } else {
      # Timestamp was okay
      set rdate [utl_sql_stamp_to_datetime $rstamp]
      set ustamp $rstamp
    }

    # If description has not been set, use default
    if {$rdesc == "*"} {
      set rdesc $tj_default_desc
    }

    set utjstr [tj_get_tj_str_delta $ustamp $uclock]
    set udate [tj_ctime $ustamp]

    # Check against max reminders ..
    set usql "SELECT COUNT(*) FROM tj WHERE uuser='[utl_escape $uhand]'"
    if {[catch {set nitems [tj_dbh onecolumn $usql]} uerrmsg]} {
      tj_msg $upublic $unick $uchan "err_sql" [list $uerrmsg]
      tj_log "$uerrmsg on SQL:\n$usql"
      return 1
    }

    if {$nitems >= $tj_max_items} {
      # User has too many set already
      tj_msg $upublic $unick $uchan "err_too_many" [list $nitems $tj_max_items]
      return 1
    }

    set ucreated [utl_sql_stamp_to_datetime $uclock]
    if {$umode} {
      # Insert new entry
      set usql "INSERT INTO tj (uid,uuser,ucreated,uupdated,udesc,utype,utarget) VALUES ('[utl_escape $uid]', '[utl_escape $uhand]', '$ucreated', '$ucreated', '[utl_escape $rdesc]', 0, '$rdate')"
      if {[catch {tj_dbh eval $usql} uerrmsg]} {
        tj_msg $upublic $unick $uchan "err_sql" [list $uerrmsg]
        tj_log "$uerrmsg on SQL:\n$usql"
        return 1
      }

      set cid [tj_dbh last_insert_rowid]
      tj_msg $upublic $unick $uchan "tj_set" [list $cid $uid $uhand $rdesc $udate $utjstr]
      tj_log "tj_set $cid:$uid:$uhand:$rdesc:$rdate:$udate"
    } else {
      # Update existing entry
      set usqlargs {}
      lappend usqlargs "uupdated='$ucreated'"
      if {[string length $rdesc] > 0 && $rdesc != "*"} {
        lappend usqlargs "udesc='[utl_escape $rdesc]'"
      }
      if {$rstamp != "invalid"} {
        lappend usqlargs "utarget='$rdate'"
      }

      if {[llength $usqlargs] > 0} {
        set usql "UPDATE tj SET [join $usqlargs ,] WHERE uuser='[utl_escape $uhand]' AND uid LIKE '[utl_escape $uid]'"
        if {[catch {tj_dbh eval $usql} uerrmsg]} {
          tj_msg $upublic $unick $uchan "err_sql" [list $uerrmsg]
          tj_log "$uerrmsg on SQL:\n$usql"
          return 1
        }
      }

      # Do a query
      set usql "SELECT * FROM tj WHERE uuser='[utl_escape $uhand]' AND uid LIKE '[utl_escape $uid]'"
      tj_dbh eval $usql {
        set utjstr [tj_get_tj_str_delta [utl_sql_datetime_to_stamp $utarget] $uclock]
        tj_msg $upublic $unick $uchan "tj_updated" [list $id $uid $uhand $udesc $udate $utjstr]
        tj_log "tj_updated $id:$uid:$uhand:$udesc:$utarget"
      }
    }

  } elseif {[tj_cmd_match "remind" $rcmd]} {
    # XXX TODO MAYBE .. reminder functionality .. perhaps some day.
    # !tj remind #<id> <<dd.mm.yyyy [hh:mm]>|<message>>
    # !tj remind #<id> <<dd.mm [hh:mm]>|<message>>
    if {[llength $rarglist] < 3} {
      tj_msg $upublic $unick $uchan "help_add"
      return 1
    }

  } elseif {[tj_cmd_match "list" $rcmd]} {
    # !tj list [name]
    # List reminders
    if {[utl_arg_get $rarglist rindex uname 1]} {
      set uname [tj_correct_handle $uname]
    } else {
      set uname $uhand
    }

    # First, get count of items
    set usql "SELECT COUNT(*) FROM tj WHERE uuser='[utl_escape $uname]'"
    if {[catch {set nitems [tj_dbh onecolumn $usql]} uerrmsg]} {
      tj_msg $upublic $unick $uchan "err_sql" [list $uerrmsg]
      tj_log "$uerrmsg on SQL:\n$usql"
      return 1
    }

    # Then, list items
    set nitem 0
    set usql "SELECT * FROM tj WHERE uuser='[utl_escape $uname]' ORDER BY ucreated"
    tj_dbh eval $usql {
      incr nitem
      set qtarget [utl_sql_datetime_to_stamp $utarget]
      set ustr [tj_get_tj_str_delta $qtarget $uclock]
      tj_msg $upublic $unick $uchan "list_item" [list $nitem $nitems [tj_ctime $qtarget] [tj_ctimes [utl_sql_datetime_to_stamp $ucreated]] [tj_ctimes [utl_sql_datetime_to_stamp $uupdated]] $uid $udesc $ustr]
    }

    if {!$nitem} {
      tj_msg $upublic $unick $uchan "no_results" [list $uname]
    }

  } elseif {[tj_cmd_match "delete" $rcmd]} {
    # !tj delete #<id>
    if {![utl_arg_get $rarglist rindex rarg 0] || ![tj_get_id $rarg rindex uid]} {
      tj_msg $upublic $unick $uchan "help_delete"
      return 1
    }

    # Check if the desired item exists
    set usql "SELECT COUNT(*) FROM tj WHERE uuser='[utl_escape $uhand]' AND uid LIKE '[utl_escape $uid]'"
    if {[catch {set nitems [tj_dbh onecolumn $usql]} uerrmsg]} {
      tj_msg $upublic $unick $uchan "err_sql" [list $uerrmsg]
      tj_log "$uerrmsg on SQL:\n$usql"
      return 1
    }

    if {$nitems == 0} {
      # No, error out
      tj_msg $upublic $unick $uchan "err_no_such_id" [list $uid]
      return 1
    }

    # Delete it
    set usql "DELETE FROM tj WHERE uuser='[utl_escape $uhand]' AND uid LIKE '[utl_escape $uid]'"
    if {[catch {set ndone [tj_dbh onecolumn $usql]} uerrmsg]} {
      tj_msg $upublic $unick $uchan "err_sql" [list $uerrmsg]
      tj_log "$uerrmsg on SQL:\n$usql"
      return 1
    }

    tj_msg $upublic $unick $uchan "items_deleted" [list $uid $nitems]

    # Check if we deleted the default ID
    set udefid [tj_get_default_id $uhand]
    if {[string tolower $uid] == [string tolower $udefid]} {
      setuser $uhand XTRA "tj_default_id" $tj_default_id

      tj_msg $upublic $unick $uchan "default_reset" [list $uid $tj_default_id]
    }

  } elseif {[tj_cmd_match "default" $rcmd]} {
    # !tj default #<id>
    # Check for #id prefix
    if {![utl_arg_get $rarglist rindex rarg 0] || ![tj_get_id $rarg rindex uid]} {
      tj_msg $upublic $unick $uchan "help_default"
      return 1
    }

    # If given ID is empty or *, clear to global default id
    if {$uid == "" || $uid == "{}" || $uid == "*"} {
      set uid $tj_default_id
    } else {
      # Check if a TJ exists with this id?
      set usql "SELECT COUNT(*) FROM tj WHERE uuser='[utl_escape $uhand]' AND uid LIKE '[utl_escape $uid]'"
      if {[catch {set nids [tj_dbh onecolumn $usql]} uerrmsg]} {
        tj_msg $upublic $unick $uchan "err_sql" [list $uerrmsg]
        tj_log "$uerrmsg on SQL:\n$usql"
        return 1
      }

      if {$nids == 0} {
        # No, error out
        tj_msg $upublic $unick $uchan "err_no_such_id" [list $uid]
        return 1
      }
    }

    setuser $uhand XTRA "tj_default_id" $uid

    tj_msg $upublic $unick $uchan "default_set" [list $uid]

  } elseif {[tj_cmd_match "show" $rcmd]} {
    # !tj show [#<id>] <name>
    # Check for #id prefix
    if {[utl_arg_get $rarglist rindex rarg 0]} {
      set notdefault [tj_get_id $rarg rindex uid]
    }

    # Check for name argument
    if {![utl_arg_get $rarglist rindex rarg 0]} {
      tj_msg $upublic $unick $uchan "help_show"
      return 1
    }

    set uname [tj_correct_handle $rarg]
    if {$uname == ""} {
      tj_msg $upublic $unick $uchan "err_unknown_user" [list $rcmd]
      return 1
    }

    if {!$notdefault} {
      set uid [tj_get_default_id $uname]
    }

    tj_display_tjs $upublic $unick $uchan $uname $uid $uclock
  } else {
    # !tj [#<id>] [name]
    set notdefault 0
    set uname $uhand
    set rindex 0
    if {[utl_arg_get $rarglist rindex rarg 0]} {
      # Check for #id prefix
      set notdefault [tj_get_id $rarg rindex uid]

      # Check if name is specified
      if {[utl_arg_get $rarglist rindex rarg 0]} {
        # Validate it
        set uname [tj_correct_handle $rarg]
        if {$uname == ""} {
          tj_msg $upublic $unick $uchan "err_unknown_user" [list $rcmd]
          return 1
        }
      }
    }

    if {!$notdefault} {
      set uid [tj_get_default_id $uname]
    }

    tj_display_tjs $upublic $unick $uchan $uname $uid $uclock
  }

  return 1
}


#-------------------------------------------------------------------------
# Script initialization
#-------------------------------------------------------------------------
putlog "$tj_message"

if {[catch {sqlite3 tj_dbh $tj_db_file} uerrmsg]} {
  putlog "Could not open SQLite3 database '${tj_db_file}': ${uerrmsg}"
  exit 2
}

# end of script