view quotedb.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 14d4d4300623
children
line wrap: on
line source

##########################################################################
#
# QuoteDB v2.7.2 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
# (C) Copyright 2003-2023 Tecnic Software productions (TNSP)
#
# This script was made for my own use, any questions about it or any
# problems you may have with it can be sent to /dev/null.
#
# This script is freely distributable under GNU GPL (version 2) license.
#
##########################################################################

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

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


##########################################################################
# No need to look below this line
##########################################################################
package require sqlite3

set qdb_name "QuoteDB"
set qdb_message "$qdb_name v2.7.2 (C) 2003-2023 ccr/TNSP"


#-------------------------------------------------------------------------
proc qdb_log {umsg} {
  global qdb_log_enable qdb_name
  if {$qdb_log_enable != 0} {
    putlog "${qdb_name}: $umsg"
  }
}


proc qdb_qm {utable uid} {
  global qdb_messages
  set qid "${utable}_${uid}"

  # Check if table-specific message exists
  if {[info exists qdb_messages($qid)]} {
    return $qdb_messages($qid)
  # Check if generic message exists
  } elseif {[info exists qdb_messages($uid)]} {
    return $qdb_messages($uid)
  } else {
    # Nothing .. return id string
    return $uid
  }
}


proc qdb_msg {acmd atable apublic anick achan aid {aargs {}}} {
  global qdb_preferredmsg

  # Get message
  set amsg [qdb_qm $atable $aid]
  set aname [qdb_qm $atable "name"]

  # Map constant tokens
  set amsg [string map [list "@cmd@" $acmd] $amsg]
  set amsg [string map [list "@name@" $aname] $amsg]

  utl_msg_args $qdb_preferredmsg $apublic $anick $achan $amsg $aargs
}


proc qdb_ctime {ustamp} {
  if {$ustamp == "" || $ustamp == "*"} {
    set ustamp 0
  }
  return [clock format $ustamp -format "%d.%m.%Y"]
}


proc qdb_sql_exec {ucmd utable upublic unick uchan usql} {
  global qdb_handle
  if {[catch {qdb_handle eval $usql} uerrmsg]} {
    qdb_log "$uerrmsg on SQL:\n$usql"
    qdb_msg $ucmd $utable $upublic $unick $uchan "sql_error"
    return 0
  }
  return 1
}


proc qdb_valid_user {ucmd utable upublic unick uchan uhand} {
  if {$uhand == "" || $uhand == {}} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "invalid_user"
    return 0
  }
  return 1
}


proc qdb_get_rating_for_id {utable uid} {
  set usql "SELECT total(${utable}_votes.vote) AS qrating FROM ${utable}_votes WHERE urlid=${uid}"
  set qrating 0
  qdb_handle eval $usql { set urating $qrating }
  return $qrating
}


#-------------------------------------------------------------------------
proc qdb_add {ucmd utable upublic unick uhost uhand uchan uargs} {
  global qdb_handle

  if {![qdb_valid_user $ucmd $utable $upublic $unick $uchan $uhand]} {
    return 0
  }

  if {$uargs == "" || $uargs == {}} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "help_add"
    return 0
  }

  set usql "INSERT INTO $utable (utime,utext,user,host,chan) VALUES ([unixtime], '[utl_escape $uargs]', '[utl_escape $uhand]', '[utl_escape $uhost]', '[utl_escape $uchan]')"
  if {![qdb_sql_exec $ucmd $utable $upublic $unick $uchan $usql]} {
    return 0
  }

  set quoteID [qdb_handle last_insert_rowid]
#  set numQuotes 0
#  set usql "SELECT count(*) AS numQuotes FROM $utable"
#  if {![qdb_sql_exec $ucmd $utable $upublic $unick $uchan $usql]} { return 0 }

  ### Log some data
  qdb_log "Added ${utable} #${quoteID} (${unick}/${uhand}@${uchan}): ${uargs}"

  ### Report success to user
  qdb_msg $ucmd $utable $upublic $unick $uchan "add_success" [list $quoteID]
  return 1
}


#-------------------------------------------------------------------------
proc qdb_delete {ucmd utable upublic unick uhost uhand uchan uargs} {
  global qdb_handle qdb_max_deltime

  set maxdiff [expr $qdb_max_deltime * 60]

  if {![qdb_valid_user $ucmd $utable $upublic $unick $uchan $uhand]} {
    return 0
  }

  if {![regexp {^\s*([0-9]+)$} $uargs -> unum]} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "help_delete"
    return 0
  }

  set qoverride [matchattr $uhand n]
  set usql "SELECT utime AS utime FROM $utable WHERE id=$unum"
  if {$qoverride == 0} {
    append usql " AND user LIKE '[utl_escape $uhand]'"
    set qextra ""
  } else {
    set qextra [qdb_qm $utable "update_override"]
  }

  qdb_handle eval $usql {
    set udiff [expr [unixtime] - $utime]
    if {$udiff < $maxdiff || $qoverride} {
      set usql "DELETE FROM $utable WHERE id=$unum"
      if {![qdb_sql_exec $ucmd $utable $upublic $unick $uchan $usql]} {
        return 0
      } else {
        set usql "DELETE FROM ${utable}_votes WHERE urlid=$unum"
        if {![qdb_sql_exec $ucmd $utable $upublic $unick $uchan $usql]} {
          return 0
        }
        qdb_msg $ucmd $utable $upublic $unick $uchan "quote_deleted" [list $unum $qextra]
        return 1
      }
    } else {
      qdb_msg $ucmd $utable $upublic $unick $uchan "quote_too_old" [list $unum $qdb_max_deltime]
      return 0
    }
  }

  qdb_msg $ucmd $utable $upublic $unick $uchan "quote_not_found" [list $unum $uhand]
  return 0
}


#-------------------------------------------------------------------------
proc qdb_update {ucmd utable upublic unick uhost uhand uchan uargs} {
  global qdb_handle qdb_max_modtime

  set maxdiff [expr $qdb_max_modtime * 60]

  if {![qdb_valid_user $ucmd $utable $upublic $unick $uchan $uhand]} {
    return 0
  }

  if {![regexp {^\s*([0-9]+)\s+(.+)$} $uargs -> unum uquote]} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "help_update"
    return 0
  }

  set qoverride [matchattr $uhand n]
  set usql "SELECT utime AS utime FROM $utable WHERE id=$unum"
  if {$qoverride == 0} {
    append usql " AND user LIKE '[utl_escape $uhand]'"
    set qextra ""
  } else {
    set qextra [qdb_qm $utable "update_override"]
  }

  qdb_handle eval $usql {
    set udiff [expr [unixtime] - $utime]
    if {$udiff < $maxdiff || $qoverride} {
      set usql "UPDATE $utable SET utext='[utl_escape $uquote]' WHERE id=$unum"
      if {![qdb_sql_exec $ucmd $utable $upublic $unick $uchan $usql]} {
        return 0
      } else {
        qdb_msg $ucmd $utable $upublic $unick $uchan "update_ok" [list $unum $qextra]
        return 1
      }
    } else {
      qdb_msg $ucmd $utable $upublic $unick $uchan "update_too_old" [list $unum $qdb_max_modtime]
      return 0
    }
  }

  qdb_msg $ucmd $utable $upublic $unick $uchan "quote_not_found" [list $unum $uhand]
  return 0
}


#-------------------------------------------------------------------------
proc qdb_toplist {ucmd utable upublic unick uhost uhand uchan uargs unum} {
  global qdb_handle
  global qdb_toplist_min qdb_toplist_max

  if {$unum == {} || $unum == ""} {
    set unum $qdb_toplist_min
  }

  if {$unum < $qdb_toplist_min || $unum > $qdb_toplist_max} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "toplist_limit" [list $qdb_toplist_min $qdb_toplist_max]
    return 0
  }

  set uresults 0
  set usql "SELECT total(${utable}_votes.vote) AS rating, ${utable}.id AS quoteID, ${utable}.utext AS utext, ${utable}.utime AS utime,${utable}.user AS uuser, ${utable}.id AS uid FROM ${utable}_votes INNER JOIN $utable ON ${utable}_votes.urlid = ${utable}.id GROUP BY ${utable}.id ORDER BY rating DESC LIMIT $unum"
  qdb_handle eval $usql {
    incr uresults
    qdb_msg $ucmd $utable $upublic $unick $uchan "fmt_toplist" [list $uresults $quoteID $utext $uuser $rating]
  }

  return 0
}


#-------------------------------------------------------------------------
proc qdb_vote {ucmd utable upublic unick uhost uhand uchan uargs} {
  global qdb_handle

  if {![qdb_valid_user $ucmd $utable $upublic $unick $uchan $uhand]} {
    return 0
  }

  set qvote "+"
  if {$uargs == "" || [regexp {^\s*(\+|\-)\s*$} $uargs -> qvote]} {
    set usql "SELECT max(id) AS qid FROM ${utable}"
    set uid 0
    qdb_handle eval $usql { set uid $qid }
  } elseif {[regexp {^\s*([0-9]+)$} $uargs -> uid]} {
  } elseif {![regexp {^\s*([0-9]+)\s+(\+|\-)$} $uargs -> uid qvote]} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "help_vote"
    return 0
  }

  if {$qvote == "-"} {
    set qvote [qdb_qm $utable "vote_down"]
    set uvote -1
  } else {
    set qvote [qdb_qm $utable "vote_up"]
    set uvote 1
  }

  # Check if given quote ID exists.
  set uresults 0
  set usql "SELECT id AS qid FROM ${utable} WHERE id=$uid"
  qdb_handle eval $usql { incr uresults }
  if {$uresults == 0} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "quote_does_not_exist" [list $uid]
    return 0
  }

  # Check if user has previously voted this item
  set usql "SELECT id AS qid FROM ${utable}_votes WHERE user LIKE '[utl_escape $uhand]' AND urlid=$uid"
  qdb_handle eval $usql {
    # Yes, update the previous vote
    set usql "UPDATE ${utable}_votes SET vote=$uvote WHERE id=$qid"
    if {[qdb_sql_exec $ucmd $utable $upublic $unick $uchan $usql]} {
      set urating [qdb_get_rating_for_id $utable $uid]
      qdb_log "${uhand} changed vote to ${uvote} on #${uid} / ${utable}, total ${urating}"
      qdb_msg $ucmd $utable $upublic $unick $uchan "vote_updated" [list $uid $qvote $urating]
      return 1
    } else {
      return 0
    }
  }

  # No previous votes, insert new
  set usql "INSERT INTO ${utable}_votes (user,urlid,vote) VALUES ('[utl_escape $uhand]',$uid,$uvote)"
  if {[qdb_sql_exec $ucmd $utable $upublic $unick $uchan $usql]} {
    set urating [qdb_get_rating_for_id $utable $uid]
    qdb_log "${uhand} voted ${uvote} on #${uid} / ${utable}, total ${urating}"
    qdb_msg $ucmd $utable $upublic $unick $uchan "you_voted" [list $uid $qvote $urating]
  }
}


#-------------------------------------------------------------------------
proc qdb_show {ucmd utable upublic unick uhost uhand uchan uindex} {
  global qdb_handle

  set usql "SELECT total(${utable}_votes.vote) AS uvote, ${utable}.id AS quoteID, ${utable}.utext AS uquote, ${utable}.utime AS utime, ${utable}.user AS uuser FROM ${utable} LEFT JOIN ${utable}_votes ON ${utable}_votes.urlid = ${utable}.id"

  if {$uindex >= 0} {
    append usql " WHERE ${utable}.id=$uindex GROUP BY ${utable}.id"
    qdb_log "${unick} searched ${utable} #${uindex}"
  } elseif {$uindex == -1} {
    append usql " GROUP BY ${utable}.id ORDER BY RANDOM() LIMIT 1"
    qdb_log "${unick} get random ${utable}"
  } elseif {$uindex == -2} {
    append usql " GROUP BY ${utable}.id ORDER BY ${utable}.id DESC LIMIT 1"
    qdb_log "${unick} get latest ${utable}"
  } else {
    qdb_log "${unick} invalid qdb_show ${utable} index value."
    return 0
  }

  set urlprefix [qdb_qm $utable "urlprefix"]

  qdb_handle eval $usql {
    if {[string range $uquote 0 3] == "img:"} {
      set uquote "${urlprefix}[string range $uquote 4 end]"
    }
    qdb_msg $ucmd $utable $upublic $unick $uchan "fmt_get" [list $quoteID $uquote $uuser [qdb_ctime $utime] $uvote]
    return 1
  }

  qdb_msg $ucmd $utable $upublic $unick $uchan "quote_does_not_exist" [list $uindex]
  return 0
}


#-------------------------------------------------------------------------
proc qdb_stats {ucmd utable upublic unick uhost uhand uchan uargs} {
  global qdb_handle

  set usql "SELECT count(*) AS nvotes FROM ${utable}_votes"
  qdb_handle eval $usql {}

  set usql "SELECT count(*) AS nquotes FROM ${utable}"
  qdb_handle eval $usql {}

  set nmaxtop 5

  set usql "SELECT user,count(*) AS uquotes FROM ${utable} GROUP BY user ORDER BY uquotes DESC LIMIT ${nmaxtop}"
  set ltopusers {}
  set ntopusers 0
  qdb_handle eval $usql {
    incr ntopusers
    lappend ltopusers "${user} (${uquotes})"
  }

  set nmaxtop 3

  set usql "SELECT count(*) AS uquotes,CAST(strftime('%Y',utime,'unixepoch') AS integer) AS uyear FROM ${utable} GROUP BY uyear ORDER BY uyear DESC LIMIT ${nmaxtop}"
  set llatestyears {}
  set nlatestyears 0
  qdb_handle eval $usql {
    incr nlatestyears
    lappend llatestyears "${uquotes} (${uyear})"
  }

  set usql "SELECT count(*) AS uquotes,CAST(strftime('%Y',utime,'unixepoch') AS integer) AS uyear FROM ${utable} GROUP BY uyear ORDER BY uquotes DESC LIMIT ${nmaxtop}"
  set ltopeyears {}
  set ntopyears 0
  qdb_handle eval $usql {
    incr ntopyears
    lappend ltopeyears "${uquotes} (${uyear})"
  }

  qdb_msg $ucmd $utable $upublic $unick $uchan "stats" [list $nquotes $nvotes]
  qdb_msg $ucmd $utable $upublic $unick $uchan "stats2" [list $ntopusers [join $ltopusers ", "] $nlatestyears [join $llatestyears ", "] $ntopyears [join $ltopeyears ", "]]

  return 0
}


#-------------------------------------------------------------------------
proc qdb_find {ucmd utable upublic unick uhost uhand uchan uargs} {
  global qdb_handle qdb_showmax_pub qdb_showmax_priv

  # Limit results based on public/private
  if {$upublic == 0} {
    set ulimit $qdb_showmax_priv
  } else {
    set ulimit $qdb_showmax_pub
  }

  ### Parse the given command
  qdb_log "${unick}/${uhand}/${uchan} searched ${utable}: '${uargs}'"

  set fpatlist {}
  set ftokens [::textutil::split::splitx $uargs {\s+}]
  foreach ftoken $ftokens {
    set fprefix [string range $ftoken 0 0]
    set fpattern [string range $ftoken 1 end]

    if {$fprefix == "-"} {
      lappend fpatlist "utext NOT LIKE '%[utl_escape $fpattern]%'"
    } elseif {$fprefix == "%"} {
      lappend fpatlist "user LIKE '[utl_escape $fpattern]'"
    } elseif {$fprefix == "@"} {
      # foo
    } elseif {$fprefix == "+"} {
      lappend fpatlist "utext LIKE '%[utl_escape $fpattern]%'"
    } else {
      lappend fpatlist "utext LIKE '%[utl_escape $ftoken]%'"
    }
  }

  # Check if any arguments exist
  if {[llength $fpatlist] == 0} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "help_find"
    return 0
  }

  set fquery "WHERE [join $fpatlist " AND "]"

  ### Query the database and output results
  set uresults 0
  set usql "SELECT count(*) AS uresults FROM $utable $fquery"
  qdb_handle eval $usql {}

  set usql "SELECT id AS quoteID, utime AS utime, utext AS utext, user AS uuser FROM $utable $fquery ORDER BY utime DESC LIMIT $ulimit"
  qdb_handle eval $usql {
    qdb_msg $ucmd $utable $upublic $unick $uchan "fmt_search" [list $quoteID $utext $uuser [qdb_ctime $utime]]
  }

  if {$uresults > $ulimit} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "num_matches" [list $uresults $ulimit]
  } elseif {$uresults == 0} {
    qdb_msg $ucmd $utable $upublic $unick $uchan "no_matches"
    return 0
  }
  return 1
}


#-------------------------------------------------------------------------
proc qdb_cmd {ucmd utable unick uhost uhand uchan uargs upublic} {
  global qdb_channels

  # Check if command comes from allowed channel or is private
  if {$upublic && ![utl_match_delim_list $qdb_channels $uchan]} {
    return 0
  }

  # Trim argument text
  set uargs [string trim $uargs]

  if {$uargs == "" || $uargs == {}} {
    # No arguments, assume random query
    qdb_show $ucmd $utable $upublic $unick $uhost $uhand $uchan -1
  } elseif {[regexp {^(stat|stats|tilasto|tilastot)$} $uargs]} {
    # Statistics
    qdb_stats $ucmd $utable $upublic $unick $uhost $uhand $uchan $uargs
  } elseif {[regexp {^(last|latest|uusin|viimeisin)$} $uargs]} {
    # Latest added
    qdb_show $ucmd $utable $upublic $unick $uhost $uhand $uchan -2
  } elseif {[regexp {^([0-9]+)$} $uargs -> unum]} {
    # Numeric argument, assume id query
    qdb_show $ucmd $utable $upublic $unick $uhost $uhand $uchan $unum
  } elseif {[regexp {^top\s*([0-9]+)?$} $uargs -> rargs]} {
    # Toplist of quotes
    qdb_toplist $ucmd $utable $upublic $unick $uhost $uhand $uchan $uargs $rargs
  } elseif {[regexp {^add\s*(.*)$} $uargs -> rargs]} {
    # Add quote
    qdb_add $ucmd $utable $upublic $unick $uhost $uhand $uchan $rargs
  } elseif {[regexp {^del\s*([0-9]*)$} $uargs -> rargs]} {
    # Delete quote
    qdb_delete $ucmd $utable $upublic $unick $uhost $uhand $uchan $rargs
  } elseif {[regexp {^update\s*(.*)$} $uargs -> rargs]} {
    # Modify/update quote
    qdb_update $ucmd $utable $upublic $unick $uhost $uhand $uchan $rargs
  } elseif {[regexp {^find\s*(.*)$} $uargs -> rargs]} {
    # Find quote(s)
    qdb_find $ucmd $utable $upublic $unick $uhost $uhand $uchan $rargs
  } elseif {[regexp {^vote\s*(.*)$} $uargs -> rargs]} {
    # Vote
    qdb_vote $ucmd $utable $upublic $unick $uhost $uhand $uchan $rargs
  } else {
    # Help/usage
    qdb_msg $ucmd $utable $upublic $unick $uchan "help"
  }
}


#-------------------------------------------------------------------------
# Script initialization
#-------------------------------------------------------------------------
putlog "$qdb_message"

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

# end of script