view quotedb.tcl @ 148:2f0c823386b0

quotedb: Simplify a bit.
author Matti Hamalainen <ccr@tnsp.org>
date Tue, 27 May 2014 07:11:29 +0300
parents 593874678e45
children fc2654064339
line wrap: on
line source

##########################################################################
#
# QuoteDB v2.1 by Matti 'ccr' Hamalainen <ccr@tnsp.org>
# (C) Copyright 2003-2011 Tecnic Software productions (TNSP)
#
# Not for public use or distribution. If you happen to find this,
# send your questions and/or problems to /dev/null, thank you.
#
##########################################################################
#
#
##########################################################################

###
### General options
###
# Path and filename of the SQLite database
set qdb_file "quotedb.sqlite"

# Verbosity (1 = be verbose, 0 = be quiet)
set qdb_verbose 0


# 1 = Enable logging of various script actions into bot's log
# 0 = Don't.
set qdb_logmsg 1


# What IRC "command" should we use to send messages:
# (Valid alternatives are "PRIVMSG" and "NOTICE")
set qdb_preferredmsg "PRIVMSG"

# Foo.
set qdb_max_deltime 15
set qdb_max_modtime 30


###
### Search related settings
###

# Limit how many quotes should the "!<cmd> find" command show at most.
set qdb_showmax_pub 3

# Same as above, but for private message search.
set qdb_showmax_priv 5


##########################################################################
# No need to look below this line
##########################################################################
set qdb_name "QuoteDB"
set qdb_version "2.1"


#-------------------------------------------------------------------------
### Binding initializations


# EXAMPLE!
bind pub - !quote quote_pub_cmd
bind msg - quote quote_msg_cmd
proc quote_pub_cmd {unick uhost uhand uchan utext} { qdb_command "!quote" "quotedb" $unick $uhost $uhand $uchan $utext 1 }
proc quote_msg_cmd {unick uhost uhand utext}       { qdb_command "quote" "quotedb" $unick $uhost $uhand "" $utext 0 }


bind pub - !spede spede_pub_cmd
bind msg - spede spede_msg_cmd
proc spede_pub_cmd {unick uhost uhand uchan utext} { qdb_command "!spede" "spededb" $unick $uhost $uhand $uchan $utext 1 }
proc spede_msg_cmd {unick uhost uhand utext}       { qdb_command "spede" "spededb" $unick $uhost $uhand "" $utext 0 }

bind pub - !mn mn_pub_cmd
bind msg - mn mn_msg_cmd
proc mn_pub_cmd {unick uhost uhand uchan utext}    { qdb_command "!mn" "mndb" $unick $uhost $uhand $uchan $utext 1 }
proc mn_msg_cmd {unick uhost uhand utext}          { qdb_command "mn" "mndb" $unick $uhost $uhand "" $utext 0 }

bind pub - !tuksu tuksu_pub_cmd
bind msg - tuksu tuksu_msg_cmd
proc tuksu_pub_cmd {unick uhost uhand uchan utext} { qdb_command "!tuksu" "tuksudb" $unick $uhost $uhand $uchan $utext 1 }
proc tuksu_msg_cmd {unick uhost uhand utext}       { qdb_command "tuksu" "tuksudb" $unick $uhost $uhand "" $utext 0 }



#-------------------------------------------------------------------------
### Initialization messages
set qdb_message "$qdb_name v$qdb_version by ccr/TNSP"
putlog "$qdb_message"

### Require packages
package require sqlite3

### SQLite database initialization
if {[catch {sqlite3 quotedb $qdb_file} uerrmsg]} {
  putlog " Could not open SQLite3 database '$qdb_file': $uerrmsg"
  exit 2
}


#-------------------------------------------------------------------------
### Utility functions
proc qdb_log {jarg} {
  global qdb_logmsg qdb_name

  if {$qdb_logmsg != 0} {
    putlog "$qdb_name: $jarg"
  }
}

proc qdb_ctime {utime} {
  if {$utime == "" || $utime == "*"} {
    set utime 0
  }

  return [clock format $utime -format "%d.%m.%Y %H:%M"]
}

proc qdb_msg {apublic anick achan amsg} {
  global qdb_preferredmsg

  if {$apublic == 0} {
    putserv "$qdb_preferredmsg $anick :$amsg" 
  } else {
    putserv "$qdb_preferredmsg $achan :$amsg"
  }
}

proc qdb_escape {str} {
  return [string map {' ''} $str]
}

proc qdb_sql_exec { upublic unick uchan usql } {
  global quotedb
  if {[catch {quotedb eval $usql} uerrmsg]} {
    qdb_log "$uerrmsg on SQL:\n$usql"
    qdb_msg $upublic $unick $uchan "virhe sörkittäessä tietokantaa. uliskaa."
    return 0
  }
  return 1
}

proc qdb_split {str maxlen} {
  set pos 0 
  set len [string length $str]
  set ulen 0
  set ustr ""
  set result {}
  while {$pos < $len} {
    set end [string wordend $str $pos]
    set new [expr $end - $pos + 1]
    if {$ulen + $new < $maxlen} {
      append ustr [string range $str $pos $end]
      set ulen [expr $ulen + $new]
    } else {
      append ustr [string range $str $pos $end]
      lappend result $ustr
      set ustr ""
      set ulen 0
    }
    set pos [expr $end + 1]
  }
  if {$ustr != ""} {
    lappend result $ustr
  }
  return $result
}


#-------------------------------------------------------------------------
proc qdb_add {ucmd utable unick uhost uhand uchan utext upublic} {
  global quotedb

  if {$uhand == "" || $uhand == {}} {
    qdb_msg $upublic $unick $uchan "pyh."
    return 0
  }

  if {$utext == "" || $utext == {}} {
    qdb_msg $upublic $unick $uchan "$ucmd add <teksti>"
    return 0
  }

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

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

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

  ### Report success to user
  qdb_msg $upublic $unick $uchan "tietokantaa $utable sörkitty (#$quoteID), kiitos."
  return 1
}


#-------------------------------------------------------------------------
proc qdb_delete {ucmd utable unick uhand uchan utext upublic} {
  global quotedb qdb_max_deltime
  set maxdiff [expr $qdb_max_deltime * 60]

  if {$uhand == "" || $uhand == {}} {
    qdb_msg $upublic $unick $uchan "pyh."
    return 0
  }

  if {![regexp {^\s*([0-9]+)$} $utext umatch unum]} {
    qdb_msg $upublic $unick $uchan "$ucmd del <id>"
    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='[qdb_escape $uhand]'"
    set qextra ""
  } else {
    set qextra " (owner/time override)"
  }
  
  quotedb eval $usql {
    set udiff [expr [unixtime] - $utime]
    if {$udiff < $maxdiff || $qoverride} {
      set usql "DELETE FROM $utable WHERE id=$unum"
      if {![qdb_sql_exec $upublic $unick $uchan $usql]} {
        return 0
      } else {
        set usql "DELETE FROM ${utable}_votes WHERE urlid=$unum"
        if {![qdb_sql_exec $upublic $unick $uchan $usql]} {
          return 0
        }
        qdb_msg $upublic $unick $uchan "$utable #$unum poistettu$qextra."
        return 1
      }
    } else {
      qdb_msg $upublic $unick $uchan "$utable quote #$unum vanhempi kuin $qdb_max_deltime minuuttia, ei poisteta."
      return 0
    }
  }

  qdb_msg $upublic $unick $uchan "#$unum ei löydy, tai se ei kuulu käyttäjälle '$uhand'."
  return 0
}


#-------------------------------------------------------------------------
proc qdb_update {ucmd utable unick uhand uchan utext upublic} {
  global quotedb qdb_max_modtime
  set maxdiff [expr $qdb_max_modtime * 60]

  if {$uhand == "" || $uhand == {}} {
    qdb_msg $upublic $unick $uchan "pyh."
    return 0
  }

  if {![regexp {^\s*([0-9]+)\s+(.+)$} $utext umatch unum uquote]} {
    qdb_msg $upublic $unick $uchan "$ucmd update <id> <teksti>"
    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='[qdb_escape $uhand]'"
    set qextra ""
  } else {
    set qextra " (owner/time override)"
  }

  quotedb eval $usql {
    set udiff [expr [unixtime] - $utime]
    if {$udiff < $maxdiff || $qoverride} {
      set usql "UPDATE $utable SET utext='[qdb_escape $uquote]', utime=[unixtime] WHERE id=$unum"
      if {![qdb_sql_exec $upublic $unick $uchan $usql]} {
        return 0
      } else {
        qdb_msg $upublic $unick $uchan "$utable #$unum päivitetty$qextra."
        return 1
      }
    } else {
      qdb_msg $upublic $unick $uchan "$utable quote #$unum vanhempi kuin $qdb_max_modtime minuuttia, ei voida päivittää."
      return 0
    }
  }

  qdb_msg $upublic $unick $uchan "#$unum ei löydy, tai se ei kuulu käyttäjälle '$uhand'."
  return 0
}


#-------------------------------------------------------------------------
proc qdb_toplist {ucmd utable unick uchan unum upublic} {
  global quotedb

  if {$unum < 2 || $unum > 4} {
#    qdb_msg $upublic $unick $uchan "top-listan pituus oltava 2-4."
    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"
  quotedb eval $usql {
    incr uresults
    qdb_msg $upublic $unick $uchan "${uresults}. #${quoteID}: $utext ($uuser, $rating)"
  }

  return 0
}


#-------------------------------------------------------------------------
proc qdb_vote {ucmd utable unick uhand uchan utext upublic} {
  global quotedb

  if {$uhand == "" || $uhand == {}} {
    qdb_msg $upublic $unick $uchan "pyh."
    return 0
  }

  set uvote 1
  if {$utext == "" || [regexp {^\s*-1$} $utext umatch uvote]} {
    set usql "SELECT max(id) AS qid FROM ${utable}"
    set uid 0
    quotedb eval $usql { set uid $qid }
  } elseif {[regexp {^\s*([0-9]+)$} $utext umatch uid]} {
  } elseif {![regexp {^\s*([0-9]+)\s+(-1|1)$} $utext umatch uid uvote]} {
    qdb_msg $upublic $unick $uchan "$ucmd vote \[<id> \[1|-1\]\]"
    return 0
  }

  # Check if given quote ID exists.
  set uresults 0
  set usql "SELECT id AS qid FROM ${utable} WHERE id=$uid"
  quotedb eval $usql { incr uresults }
  if {$uresults == 0} {
    qdb_msg $upublic $unick $uchan "quotea #$uid ei ole."
    return 0
  }

  # Check if user has previously voted this item
  set usql "SELECT id AS qid FROM ${utable}_votes WHERE user='[qdb_escape $uhand]' AND urlid=$uid"
  quotedb eval $usql {
    # Yes, update the previous vote
    set usql "UPDATE ${utable}_votes SET vote=$uvote WHERE id=$qid"
    if {[qdb_sql_exec $upublic $unick $uchan $usql]} {
      qdb_log "$uhand changed vote to $uvote on #$uid / $utable"
      qdb_msg $upublic $unick $uchan "ääni päivitetty #$uid -> $uvote"
      return 1
    } else {
      return 0
    }
  }

  # No previous votes, insert new
  set usql "INSERT INTO ${utable}_votes (user,urlid,vote) VALUES ('[qdb_escape $uhand]',$uid,$uvote)"
  if {[qdb_sql_exec $upublic $unick $uchan $usql]} {
    qdb_log "$uhand voted $uvote on #$uid / $utable"
    qdb_msg $upublic $unick $uchan "äänestit #$uid -> $uvote"
  }
}


#-------------------------------------------------------------------------
proc qdb_get {ucmd utable unick uchan uindex upublic} {
  global quotedb

  set usql "SELECT total(${utable}_votes.vote) AS uvote, ${utable}.id AS quoteID, ${utable}.utext AS utext, ${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"
  } else {
    append usql " GROUP BY ${utable}.id ORDER BY RANDOM() LIMIT 1"
    qdb_log "$unick get random $utable"
  }

  quotedb eval $usql {
    set qtmp [qdb_split "#${quoteID}: $utext ($uuser, $uvote)" 450]
    foreach qstr $qtmp {
      qdb_msg $upublic $unick $uchan $qstr
    }
    return 1
  }

  qdb_msg $upublic $unick $uchan "ei löydy."
  return 0
}


#-------------------------------------------------------------------------
proc qdb_find {ucmd utable unick uhand uchan utext upublic} {
  global quotedb qdb_showmax_pub qdb_showmax_priv

  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: $utext"

  set ftokens [split $utext " "]
  set fpatlist ""
  foreach ftoken $ftokens {
    set fprefix [string range $ftoken 0 0]
    set fpattern [string range $ftoken 1 end]

    if {$fprefix == "-"} {
      lappend fpatlist "utext NOT LIKE '%[qdb_escape $fpattern]%'"
    } elseif {$fprefix == "%"} {
      lappend fpatlist "user LIKE '[qdb_escape $fpattern]'"
    } elseif {$fprefix == "@"} {
      # foo
    } elseif {$fprefix == "+"} {
      lappend fpatlist "utext LIKE '%[qdb_escape $fpattern]%'"
    } else {
      lappend fpatlist "utext LIKE '%[qdb_escape $ftoken]%'"
    }
  }
  if {[llength $fpatlist] > 0} {
    set fquery "WHERE [join $fpatlist " AND "]"
  } else {
    set fquery ""
  }

  ### Query the database and output results
  set uresults 0
  set usql "SELECT id AS quoteID, utime AS utime, utext AS utext, user AS uuser FROM $utable $fquery ORDER BY utime DESC LIMIT $ulimit"
  quotedb eval $usql {
    incr uresults
    qdb_msg $upublic $unick $uchan "#${quoteID}: $utext ($uuser@[qdb_ctime $utime])"
  }
  
  if {$uresults == 0} {
    qdb_msg $upublic $unick $uchan "ei löydy."
    return 0
  }
  return 1
}


#-------------------------------------------------------------------------
proc qdb_command {ucmd utable unick uhost uhand uchan utext upublic} {
  set utext [string trim $utext]

  if {$utext == "" || $utext == {}} {
    # No arguments, assume random query
    qdb_get $ucmd $utable $unick $uchan -1 $upublic
  } elseif {[regexp {^([0-9]+)$} $utext umatch unum]} {
    # Numeric argument, assume index query
    qdb_get $ucmd $utable $unick $uchan $unum $upublic
  } elseif {[regexp {^top\s*([0-9]+)$} $utext umatch unum]} {
    # Toplist of quotes
    qdb_toplist $ucmd $utable $unick $uchan $unum $upublic
  } elseif {[regexp {^add\s*(.*)$} $utext umatch unum]} {
    # Add quote
    qdb_add $ucmd $utable $unick $uhost $uhand $uchan $unum $upublic
  } elseif {[regexp {^del\s*([0-9]*)$} $utext umatch unum]} {
    # Delete quote
    qdb_delete $ucmd $utable $unick $uhand $uchan $unum $upublic
  } elseif {[regexp {^update\s*(.*)$} $utext umatch unum]} {
    # Modify/update quote
    qdb_update $ucmd $utable $unick $uhand $uchan $unum $upublic
  } elseif {[regexp {^find\s*(.*)$} $utext umatch unum]} {
    # Find quote(s)
    qdb_find $ucmd $utable $unick $uhand $uchan $unum $upublic
  } elseif {[regexp {^vote\s*(.*)$} $utext umatch unum]} {
    # Vote
    qdb_vote $ucmd $utable $unick $uhand $uchan $unum $upublic
  } else {
    qdb_msg $upublic $unick $uchan "$ucmd add <teksti>|update <id> <teksti>|del <id>|find <parametrit>|vote|top3"
  }
}

#-------------------------------------------------------------------------
# end of script