Mercurial > hg > egg-tcls
view tj.tcl @ 646:cf62cdc44568
tj: Add comment.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Tue, 16 Feb 2021 13:16:08 +0200 |
parents | 77c9feb5dcee |
children | 98e2254056b2 |
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_arg_rest {rarglist rindex rstr} { upvar $rstr dstr if {$rindex < [llength $rarglist]} { set dstr [join [lrange $rarglist $rindex end] " "] return 1 } else { return 0 } } # ------------------------------------------------------------------------ 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_remaining" 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 } } tj_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 tj_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 tj_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 < 1} { 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] if {[utl_arg_get $rarglist rindex rarg 0]} { 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