faq.tcl
#### faq.tcl v1.0.0 ############################################################
################################################################################
## Written by: ##
## KuNgFo0 (http://www.eggfaq.com/). ##
## ##
## Modified by: ##
## Brian Schmidt aka. brianMan. ##
################################################################################
#### Readme / Help #############################################################
################################################################################
## This script is ripped from KuNgFoO's ib.tcl v3.19 (infobot) script. ##
################################################################################
#### Changelog #################################################################
################################################################################
## v1.0.0 ##
## + Initial release. ##
## + Added the possibility to control which channels could use the commands ##
## with a channel flag. ##
## * Applied a dirty hack to solve a minor redirection bug, which caused all ##
## add/append/remove commands that contained a > to break the script. ##
################################################################################
# Set next line as the directory where the database files are
# located (no other files should be in the same dir)
set faq_dir "data/"
# Set the next line as the default database to save changes to
set faq_database "FooBot.dat"
# What should the channel flag be, to enable the FAQ for that channel?
set faq_channel_flag "faq"
# The default value should be ok for the next two:
# Set the next line as the format to display time in (without timezone)
set faq_format_notz "%H:%M:%S - %A, %B %d, %Y"
# Set the next line as the format to display time in (with timezone)
set faq_format "$faq_format_notz %Z"
# Set the next line as the maxinum number of matches to
# return on searches
set faq_max 5
# Set the next line as the maxinum number of lines to
# return publicly
set faq_max_lines 3
# Set the next line as the flag required to add/remove
# questions and etc
set faq_flag "+f"
# Set the next line as how often to save changes to the database
# (in minutes)
set faq_time 10
proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}
proc xindex {xr xr1} {
return [join [lrange [split $xr] $xr1 $xr1]]
}
proc validnum {num} {
return [expr [scan $num "%f%s" a b] == 1]
}
proc anymatch {string1 string2} {
foreach string $string2 {
if {[lsearch -exact [string tolower $string1] [string tolower $string]] != -1} {
return 1
}
}
return 0
}
proc parseurl {url} {
foreach var {protocol user pass server port path cgiargs anchor} { upvar 1 $var $var }
if {[regexp {(([^:]+)://)?(([^:]+):([^@]+)@)?([^:/\?#]+)(:([0-9]+))?(/([^\?#]+))?(\?([^#]+))?(#(.*))?} $url a b protocol c user pass server d port e path f cgiargs g anchor]} {
if {$protocol == ""} {
set protocol "http"
}
if {![validnum $port]} {
set port 80
}
return 1
} else {
return 0
}
}
# Begin Database code
proc faq_fixtopic {arg} {
regsub -all {[\\\{\}\[\]\"]} $arg {} arg ; # Bad characters
regsub -all {(\s)+} $arg {\1} arg ; # Double whitespace
regsub -all {^\s*|\s*$} $arg {} arg ; # Whitespace at ends
return $arg
}
proc faq_fixdb {arg} {
global faq_databases
if {[set i [lsearch -exact [string tolower $faq_databases] [string tolower $arg]]] == -1} {
return "error no such database '$arg' loaded"
} else {
return [lindex $faq_databases $i]
}
}
proc faq_fixdata {arg output} {
global botnick
if {[string index $output 0] != "#"} {
regsub -all -nocase {$output's} $arg "your" arg
}
regsub -all -nocase {$botnick's} $arg "my" arg
return $arg
}
proc faq_msg {targets arg} {
foreach target $targets {
puthelp "PRIVMSG $target :[faq_fixdata $arg $target]"
}
}
proc faq_check {} {
global faq_dir
if {![file exists $faq_dir]} {
return "error $faq_dir does not exist"
} elseif {![file isdirectory $faq_dir]} {
return "error $faq_dir is not a directory"
} elseif {![file readable $faq_dir]} {
return "error $faq_dir is unreadable"
} elseif {![file writable $faq_dir]} {
return "error $faq_dir is unwritable"
}
return ""
}
proc faq_loadall {output1 output2} {
global faq_dir faq_databases
# Unset current databases first
faq_unloadall
if {[set error [faq_check]] != ""} {
if {$output1 == ""} {
putlog $error
} else {
faq_msg $output1 $error
}
} else {
foreach file [glob -nocomplain [file join $faq_dir *]] {
if {[file isfile $file]} {
if {[xindex [set output [faq_load [file tail $file]]] 0] == "error"} {
if {$output1 == ""} {
putlog $output
} else {
faq_msg $output1 $output
}
} else {
if {$output2 == ""} {
putlog $output
} else {
faq_msg $output2 $output
}
}
}
}
}
}
proc faq_load {database} {
global faq_dir faq_databases faq_data_$database
set file [file join $faq_dir $database]
faq_unload $database
if {([string match *..* $database]) || ([string index $database 0] == "/")} {
return "error invalid database name '$database'"
} elseif {![file exists $file]} {
return "error database '$database' does not exist"
} elseif {![file isfile $file]} {
return "error database '$database' is not a valid file"
} elseif {[catch {open $file r} fileid]} {
return "error could not read database '$database'"
} else {
if {[catch {array set faq_data_$database [read $fileid]}]} {
return "error could not parse database '$database'"
}
close $fileid
lappend faq_databases $database
return "read database '$database'"
}
}
proc faq_unloadall {} {
global faq_databases
if {[info exists faq_databases]} {
foreach database $faq_databases {
faq_unload $database
}
}
set faq_databases ""
}
proc faq_unload {database} {
global faq_databases faq_data_$database
if {[array exists faq_data_$database]} {
array unset faq_data_$database
}
if {[set i [lsearch -exact $faq_databases $database]] != -1} {
set faq_databases [lreplace $faq_databases $i $i]
}
}
proc faq_saveall {output1 output2} {
global faq_databases faq_save
set error 0
if {[set output [faq_check]] != ""} {
if {$output1 == ""} {
putlog $error
} else {
faq_msg $output1 $output
}
set error 1
} else {
foreach database $faq_databases {
if {[xindex [set output [faq_save $database]] 0] == "error"} {
if {$output1 == ""} {
putlog $output
} else {
faq_msg $output1 $output
}
set error 1
} else {
if {$output2 == ""} {
putlog $output
} else {
faq_msg $output2 $output
}
}
}
}
set faq_save $error
}
proc faq_save {database} {
global faq_dir faq_databases faq_data_$database
if {[catch {open [file join $faq_dir $database] w} fileid]} {
return "error could not write database 'database'"
} else {
puts $fileid [array get faq_data_$database]
close $fileid
return "wrote database '$database'"
}
}
proc faq_needsave {} {
global faq_save
set faq_save 1
}
proc time_faq {} {
global faq_time faq_save
if {$faq_save} {
faq_saveall "" ""
}
if {![string match *time_faq* [timers]]} {
timer $faq_time time_faq
}
}
proc faq_topics {arg} {
set topics ""
set arg [string trimright $arg "?! "]
set length [llength $arg]
for {set l $length} {$l > 0} {incr l -1} {
for {set i [expr $length - $l]} {$i >= 0} {incr i -1} {
if {[lsearch -exact [string tolower $topics] [string tolower [set topic [lrange $arg $i [expr $i + $l - 1]]]]] == -1} {
lappend topics $topic
}
}
}
return $topics
}
# {"topic 1" "topic 2" ...} -> faq_find -> {"database" "first topic found"}
# note: databases are not checked for validity
proc faq_find {topics} {
global faq_databases
foreach topic $topics {
set topic [faq_fixtopic $topic]
foreach database $faq_databases {
if {[xindex [set topic2 [faq_exists $topic $database 1]] 0] != "error"} {
return [list $database $topic2]
}
}
}
}
# "*topic string*" -> faq_find2 -> { {"database" "topic found 1"} {"database" "topic found 2"} ... }
proc faq_find2 {topic} {
global faq_databases
set topic [faq_fixtopic $topic]
set topics ""
foreach database $faq_databases {
global faq_data_$database
# [array names faq_data_$database -glob *topic*] would be really nice here, but it has no -nocase option!
foreach topic2 [array names faq_data_$database] {
if {[string match -nocase *$topic* $topic2]} {
lappend topics [list $database $topic2]
}
}
}
return $topics
}
proc faq_parsetopic {arg var1 var2} {
global $var1 $var2
set i [string first "=" $arg]
set $var1 [string trim [string range $arg 0 [expr $i - 1]] " "]
set $var2 [string trim [string range $arg [expr $i + 1] end] " "]
for {set i 1} {$i <= 2} {incr i} {
if {[string match "topic*" [set topic_var [set var$i]]]} {
# if this is a topic, we look for a database too
set database_var "database[string range $topic_var 5 end]"
if {[xindex [set error [faq_parsedb [set $topic_var] $topic_var $database_var]] 0] == "error"} {
return $error
} ; # we got an error parsing the db
}
}
if {([set $var1] == "") || ([set $var2] == "") || ($i == -1)} {
return "error parsing sentence"
}
}
proc faq_parsedb {arg var1 var2} {
global faq_database $var1 $var2
if {[set i [string last "|" $arg]] != -1} {
set $var1 [string trim [string range $arg 0 [expr $i - 1]] " "]
set $var2 [string trim [string range $arg [expr $i + 1] end] " "]
} else {
if {[set tmp [faq_find [list $arg]]] != ""} {
set $var2 [lindex $tmp 0] ; # we go with the db that this topic is already stored in
} else {
set $var2 $faq_database ; # we go w/ default db
}
}
if {([set $var1 [faq_fixtopic [set $var1]]] == "") || ([set $var2] == "")} {
return "error parsing sentence"
}
return [set $var2 [faq_fixdb [set $var2]]] ; # this may return an error
}
# type = 0, returns 1/0 ; type = 1, returns proper case (or error), for use with existing topics ;
# type = 2, returns proper case (or original topic), for use with creating new topics
proc faq_exists {topic database type} {
global faq_data_$database
if {[set i [lsearch [string tolower [array names faq_data_$database]] [string tolower $topic]]] != -1} {
if {$type == 0} {
return 1
} else {
return [lindex [array names faq_data_$database] $i]
}
} else {
if {$type == 0} {
return 0
} elseif {$type == 1} {
return "error topic '$topic' does not exist in database '$database'"
} else {
return $topic
}
}
}
proc faq_write {topic database type arg host} {
global faq_data_$database
set topic [faq_exists $topic $database 2]
if {$type == "w"} {
set faq_data_${database}($topic) [list $arg]
} elseif {$type == "a"} {
lappend faq_data_${database}($topic) $arg
}
lappend faq_data_${database}($topic) "#WHOSET $host [clock seconds]"
}
proc faq_read {topic database} {
global faq_data_$database
if {[xindex [set database [faq_fixdb $database]] 0] == "error"} {
return $database
} elseif {[xindex [set topic [faq_exists $topic $database 1]] 0] == "error"} {
return $topic
} else {
return [set faq_data_${database}($topic)]
}
}
proc faq_copy {topic1 database1 topic2 database2} {
global faq_data_$database1 faq_data_$database2
if {[faq_exists $topic2 $database2 0]} {
return "error topic '$topic2' already exists in database '$database2'"
} elseif {[xindex [set output [faq_read $topic1 $database1]] 0] == "error"} {
return $output
} else {
set faq_data_${database2}($topic2) $output
}
}
proc faq_remove {topic database} {
global faq_data_$database
if {[xindex [set topic [faq_exists $topic $database 1]] 0] == "error"} {
return $topic
} else {
unset faq_data_${database}($topic)
}
}
proc faq_disp {arg database output1 output2 depth num option nick} {
global faq_max_lines
if {$depth >= 3} {
faq_msg $output1 "error recursion too deep"
return -1
}
set found 0
if {$database != ""} {
set list [list [list $database $arg]] ; # we have an exact topic/db to display
} else {
set list [list [faq_find [faq_topics $arg]]]; # find topic/db (s)
}
# note: the $list vars above needed to be padded with { } - hence the [list] 's
foreach tmp $list {
if {$tmp == ""} {
continue
}
if {!$depth} {
set num 0
}
if {[xindex [set output [faq_read [set topic [lindex $tmp 1]] [set database [lindex $tmp 0]]]] 0] == "error"} {
faq_msg $output1 $output
} else {
foreach line $output {
if {($line == "") || ([xindex $line 0] == "#WHOSET")} {
#ignore
} elseif {[xindex $line 0] == "#LINK"} {
if {[set temp [faq_disp [lindex $line 1] [lindex $line 2] $output1 $output2 [expr $depth + 1] $num 0 $nick]] > 0} {
incr num $temp
}
} elseif {[xindex $line 0] == "."} {
faq_msg $output2 [xrange $line 1 end]
incr num
} elseif {!$num} {
faq_msg $output2 "$topic - $line"
incr num
} else {
faq_msg $output2 "... $line"
incr num
}
}
if {!$num} {
faq_msg $output1 "error '$topic' exists, but is empty"
} elseif {(![string equal -nocase $output2 $output1]) && (!$depth)} {
faq_msg $output2 "(sent by $output1)"
faq_msg $output1 "sent '$topic' to $output2"
}
incr found
}
}
if {!$found} {
if {$depth > 0} {
faq_msg $output1 "error invalid link to '$arg'"
}
}
return $num
}
# End Database code
# Begin 'calc' code
proc faq_fixexpr {exp} {
global faq_const
set exp [faq_fixtopic $exp]
foreach i [array names faq_const] {
regsub -all "\%$i" $exp $faq_const($i) exp
}
return $exp
}
# End 'calc' code
# expr's abs() and int() can't handle large unsigned integers,
# these functions are just to get around this
proc faq_int {value} {
return [lindex [split $value "."] 0]
}
proc faq_abs {value} {
return [string trimleft $value "-"]
}
proc faq_absint {value} {
return [faq_int [faq_abs $value]]
}
# Begin Public binds code
proc msg_faq {nick uhost hand arg} {
pub_faq $nick $uhost $hand "" $arg
}
proc pub_faq {nick uhost hand chan arg} {
global botnick faq_dir faq_format faq_max faq_flag faq_database faq_databases faq_channel_flag
global topic topic1 topic2 database database1 database2 value
if {(![isbotnick $nick]) && (![matchattr $hand +b]) && ((($chan != "") && ([channel get $chan $faq_channel_flag])) || ($chan == ""))} {
if {[string match -nocase $botnick* $arg]} {
set arg [xrange $arg 1 end] ; # Only answer channel messages that begin with the bot's nick
} elseif {$chan == ""} {
# Answer all privmsgs
} else {
return ; # Msg isn't for us, bail out
}
set isuser [expr {[matchattr $hand $faq_flag|$faq_flag $chan] || [matchattr $hand $faq_flag]}] ; # Note that $chan might be "", so we must handle both cases
if {([validchan $chan]) && ($isuser)} {
set output1 $chan ; # The bot sends the text to the channel for users
} else {
set output1 $nick ; # Non-users get privmsg'd
}
set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
if {([lsearch -exact [split "shutup stop sh database db set learn add unset forget delete del remove rem rm erase append addon link join copy cp move mv rename ren"] [string tolower [xindex $arg 0]]] == -1) && ([set i [string last ">" $arg]] != -1)} {
# Output has been redirected
if {(!$isuser) || ([set output2 [string trim [string range $arg [expr $i + 1] end] " "]] == "")} {
set output2 $output1 ; # Error (User doesn't have access, or output was ""), so we go back to the default
}
set arg [string trim [string range $arg 0 [expr $i - 1]] " "]
}
set command [string tolower [xindex $arg 0]]
set remainder [xrange $arg 1 end]
switch -- $command {
"shutup" - "stop" - "sh" {
if {$isuser} {
if {[clearqueue help]} {
faq_msg $output2 "OK, sorry"
} else {
faq_msg $output2 "But I'm not saying anything!"
}
}
}
"database" - "db" {
if {$isuser} {
switch -- [string tolower [xindex $remainder 0]] {
"reload" {
faq_loadall $output1 $output2
}
"save" {
faq_saveall $output1 $output2
}
"list" {
set i 1
faq_msg $output2 "Loaded database(s):"
foreach database $faq_databases {
global faq_data_$database
faq_msg $output2 [format "%s %-15s %s" $i. $database #[array size faq_data_$database]]
incr i
}
faq_msg $output2 "end"
}
default {
faq_msg $output1 "error must be one of 'reload', 'save' , or 'list'"
}
}
}
}
"set" - "learn" - "add" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic value]] 0] == "error") || \
([xindex [set error [faq_write $topic $database "w" $value $nick!$uhost]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Set '$topic' in database '$database'"
faq_needsave
}
}
}
"unset" - "forget" - "delete" - "del" - "remove" - "rem" - "rm" - "erase" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic "$remainder = null" topic value]] 0] == "error") || \
([xindex [set error [faq_remove $topic $database]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Unset '$topic' in database '$database'"
faq_needsave
}
}
}
"append" - "addon" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic value]] 0] == "error") || \
([xindex [set error [faq_write $topic $database "a" $value $nick!$uhost]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Appended to '$topic' in database '$database'"
faq_needsave
}
}
}
"link" - "join" {
if {$isuser} {
if {[xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == "error"} {
faq_msg $output1 $error
} elseif {[xindex [set topic2 [faq_exists $topic2 $database2 1]] 0] == "error"} {
faq_msg $output1 $topic2 ; # check if 2nd topic exists, get proper casing too (so $topic2 not $error is used)
} elseif {[xindex [set error [faq_write $topic1 $database1 "a" [list #LINK $topic2 $database2] $nick!$uhost]] 0] == "error"} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Linked '$topic1' ($database1) to '$topic2' ($database2)"
faq_needsave
}
}
}
"copy" - "cp" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == "error") || \
([xindex [set error [faq_copy $topic1 $database1 $topic2 $database2]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Copied '$topic1' ($database1) to '$topic2' ($database2)"
faq_needsave
}
}
}
"move" - "mv" - "rename" - "ren" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == "error") || \
([xindex [set error [faq_copy $topic1 $database1 $topic2 $database2]] 0] == "error") || \
([xindex [set error [faq_remove $topic1 $database1]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Renamed '$topic1' ($database1) to '$topic2' ($database2)"
faq_needsave
}
}
}
"list" - "find" - "search" - "locate" {
set topics [faq_find2 $remainder]
switch -- [set found [llength $topics]] {
0 {
faq_msg $output1 "Found no matches to '$remainder'"
}
1 {
faq_disp [join $topics] "" $output1 $output2 0 0 0 $nick
}
default {
faq_msg $output2 "Found $found matches to '$remainder'"
set i 1
foreach topic $topics {
faq_msg $output2 "$i. [lindex $topic 1]"
if {$i >= $faq_max} {
break
}
incr i
}
faq_msg $output2 "end"
}
}
}
"whoset" {
if {[xindex [set error [faq_parsetopic "$remainder = null" topic value]] 0] == "error"} {
faq_msg $output1 $error
} elseif {[xindex [set output [faq_read $topic $database]] 0] == "error"} {
faq_msg $output1 $output
} else {
set found 0
foreach line $output {
if {[xindex $line 0] == "#WHOSET"} {
if {!$found} {
faq_msg $output2 "'$topic' (database $database) set by [xindex $line 1] on [clock format [xindex $line 2] -format $faq_format]"
incr found
} else {
faq_msg $output2 "... modified by [xindex $line 1] on [clock format [xindex $line 2] -format $faq_format]"
}
}
}
if {!$found} {
faq_msg $output1 "error could not find who set topic '$topic'"
}
}
}
default {
faq_disp $arg "" $output1 $output2 0 0 1 $nick
}
}
}
}
# End Public binds code
# Init stuff
if {[catch {package require Tcl 8.3} error]} {
putlog "error TCL v8.3 or higher is required to run this script"
return 0
}
putlog "*** LOADED: faq.tcl"
bind pubm - * pub_faq
bind msgm - * msg_faq
setudef flag $faq_channel_flag
if {![info exists faq_load]} {
faq_loadall "" ""
set faq_load 1
}
if {![info exists faq_save]} {
set faq_save 0
}
if {![string match *time_faq* [timers]]} {
timer $faq_time time_faq
}
################################################################################
## Written by: ##
## KuNgFo0 (http://www.eggfaq.com/). ##
## ##
## Modified by: ##
## Brian Schmidt aka. brianMan. ##
################################################################################
#### Readme / Help #############################################################
################################################################################
## This script is ripped from KuNgFoO's ib.tcl v3.19 (infobot) script. ##
################################################################################
#### Changelog #################################################################
################################################################################
## v1.0.0 ##
## + Initial release. ##
## + Added the possibility to control which channels could use the commands ##
## with a channel flag. ##
## * Applied a dirty hack to solve a minor redirection bug, which caused all ##
## add/append/remove commands that contained a > to break the script. ##
################################################################################
# Set next line as the directory where the database files are
# located (no other files should be in the same dir)
set faq_dir "data/"
# Set the next line as the default database to save changes to
set faq_database "FooBot.dat"
# What should the channel flag be, to enable the FAQ for that channel?
set faq_channel_flag "faq"
# The default value should be ok for the next two:
# Set the next line as the format to display time in (without timezone)
set faq_format_notz "%H:%M:%S - %A, %B %d, %Y"
# Set the next line as the format to display time in (with timezone)
set faq_format "$faq_format_notz %Z"
# Set the next line as the maxinum number of matches to
# return on searches
set faq_max 5
# Set the next line as the maxinum number of lines to
# return publicly
set faq_max_lines 3
# Set the next line as the flag required to add/remove
# questions and etc
set faq_flag "+f"
# Set the next line as how often to save changes to the database
# (in minutes)
set faq_time 10
proc xrange {xr xr1 xr2} {
return [join [lrange [split $xr] $xr1 $xr2]]
}
proc xindex {xr xr1} {
return [join [lrange [split $xr] $xr1 $xr1]]
}
proc validnum {num} {
return [expr [scan $num "%f%s" a b] == 1]
}
proc anymatch {string1 string2} {
foreach string $string2 {
if {[lsearch -exact [string tolower $string1] [string tolower $string]] != -1} {
return 1
}
}
return 0
}
proc parseurl {url} {
foreach var {protocol user pass server port path cgiargs anchor} { upvar 1 $var $var }
if {[regexp {(([^:]+)://)?(([^:]+):([^@]+)@)?([^:/\?#]+)(:([0-9]+))?(/([^\?#]+))?(\?([^#]+))?(#(.*))?} $url a b protocol c user pass server d port e path f cgiargs g anchor]} {
if {$protocol == ""} {
set protocol "http"
}
if {![validnum $port]} {
set port 80
}
return 1
} else {
return 0
}
}
# Begin Database code
proc faq_fixtopic {arg} {
regsub -all {[\\\{\}\[\]\"]} $arg {} arg ; # Bad characters
regsub -all {(\s)+} $arg {\1} arg ; # Double whitespace
regsub -all {^\s*|\s*$} $arg {} arg ; # Whitespace at ends
return $arg
}
proc faq_fixdb {arg} {
global faq_databases
if {[set i [lsearch -exact [string tolower $faq_databases] [string tolower $arg]]] == -1} {
return "error no such database '$arg' loaded"
} else {
return [lindex $faq_databases $i]
}
}
proc faq_fixdata {arg output} {
global botnick
if {[string index $output 0] != "#"} {
regsub -all -nocase {$output's} $arg "your" arg
}
regsub -all -nocase {$botnick's} $arg "my" arg
return $arg
}
proc faq_msg {targets arg} {
foreach target $targets {
puthelp "PRIVMSG $target :[faq_fixdata $arg $target]"
}
}
proc faq_check {} {
global faq_dir
if {![file exists $faq_dir]} {
return "error $faq_dir does not exist"
} elseif {![file isdirectory $faq_dir]} {
return "error $faq_dir is not a directory"
} elseif {![file readable $faq_dir]} {
return "error $faq_dir is unreadable"
} elseif {![file writable $faq_dir]} {
return "error $faq_dir is unwritable"
}
return ""
}
proc faq_loadall {output1 output2} {
global faq_dir faq_databases
# Unset current databases first
faq_unloadall
if {[set error [faq_check]] != ""} {
if {$output1 == ""} {
putlog $error
} else {
faq_msg $output1 $error
}
} else {
foreach file [glob -nocomplain [file join $faq_dir *]] {
if {[file isfile $file]} {
if {[xindex [set output [faq_load [file tail $file]]] 0] == "error"} {
if {$output1 == ""} {
putlog $output
} else {
faq_msg $output1 $output
}
} else {
if {$output2 == ""} {
putlog $output
} else {
faq_msg $output2 $output
}
}
}
}
}
}
proc faq_load {database} {
global faq_dir faq_databases faq_data_$database
set file [file join $faq_dir $database]
faq_unload $database
if {([string match *..* $database]) || ([string index $database 0] == "/")} {
return "error invalid database name '$database'"
} elseif {![file exists $file]} {
return "error database '$database' does not exist"
} elseif {![file isfile $file]} {
return "error database '$database' is not a valid file"
} elseif {[catch {open $file r} fileid]} {
return "error could not read database '$database'"
} else {
if {[catch {array set faq_data_$database [read $fileid]}]} {
return "error could not parse database '$database'"
}
close $fileid
lappend faq_databases $database
return "read database '$database'"
}
}
proc faq_unloadall {} {
global faq_databases
if {[info exists faq_databases]} {
foreach database $faq_databases {
faq_unload $database
}
}
set faq_databases ""
}
proc faq_unload {database} {
global faq_databases faq_data_$database
if {[array exists faq_data_$database]} {
array unset faq_data_$database
}
if {[set i [lsearch -exact $faq_databases $database]] != -1} {
set faq_databases [lreplace $faq_databases $i $i]
}
}
proc faq_saveall {output1 output2} {
global faq_databases faq_save
set error 0
if {[set output [faq_check]] != ""} {
if {$output1 == ""} {
putlog $error
} else {
faq_msg $output1 $output
}
set error 1
} else {
foreach database $faq_databases {
if {[xindex [set output [faq_save $database]] 0] == "error"} {
if {$output1 == ""} {
putlog $output
} else {
faq_msg $output1 $output
}
set error 1
} else {
if {$output2 == ""} {
putlog $output
} else {
faq_msg $output2 $output
}
}
}
}
set faq_save $error
}
proc faq_save {database} {
global faq_dir faq_databases faq_data_$database
if {[catch {open [file join $faq_dir $database] w} fileid]} {
return "error could not write database 'database'"
} else {
puts $fileid [array get faq_data_$database]
close $fileid
return "wrote database '$database'"
}
}
proc faq_needsave {} {
global faq_save
set faq_save 1
}
proc time_faq {} {
global faq_time faq_save
if {$faq_save} {
faq_saveall "" ""
}
if {![string match *time_faq* [timers]]} {
timer $faq_time time_faq
}
}
proc faq_topics {arg} {
set topics ""
set arg [string trimright $arg "?! "]
set length [llength $arg]
for {set l $length} {$l > 0} {incr l -1} {
for {set i [expr $length - $l]} {$i >= 0} {incr i -1} {
if {[lsearch -exact [string tolower $topics] [string tolower [set topic [lrange $arg $i [expr $i + $l - 1]]]]] == -1} {
lappend topics $topic
}
}
}
return $topics
}
# {"topic 1" "topic 2" ...} -> faq_find -> {"database" "first topic found"}
# note: databases are not checked for validity
proc faq_find {topics} {
global faq_databases
foreach topic $topics {
set topic [faq_fixtopic $topic]
foreach database $faq_databases {
if {[xindex [set topic2 [faq_exists $topic $database 1]] 0] != "error"} {
return [list $database $topic2]
}
}
}
}
# "*topic string*" -> faq_find2 -> { {"database" "topic found 1"} {"database" "topic found 2"} ... }
proc faq_find2 {topic} {
global faq_databases
set topic [faq_fixtopic $topic]
set topics ""
foreach database $faq_databases {
global faq_data_$database
# [array names faq_data_$database -glob *topic*] would be really nice here, but it has no -nocase option!
foreach topic2 [array names faq_data_$database] {
if {[string match -nocase *$topic* $topic2]} {
lappend topics [list $database $topic2]
}
}
}
return $topics
}
proc faq_parsetopic {arg var1 var2} {
global $var1 $var2
set i [string first "=" $arg]
set $var1 [string trim [string range $arg 0 [expr $i - 1]] " "]
set $var2 [string trim [string range $arg [expr $i + 1] end] " "]
for {set i 1} {$i <= 2} {incr i} {
if {[string match "topic*" [set topic_var [set var$i]]]} {
# if this is a topic, we look for a database too
set database_var "database[string range $topic_var 5 end]"
if {[xindex [set error [faq_parsedb [set $topic_var] $topic_var $database_var]] 0] == "error"} {
return $error
} ; # we got an error parsing the db
}
}
if {([set $var1] == "") || ([set $var2] == "") || ($i == -1)} {
return "error parsing sentence"
}
}
proc faq_parsedb {arg var1 var2} {
global faq_database $var1 $var2
if {[set i [string last "|" $arg]] != -1} {
set $var1 [string trim [string range $arg 0 [expr $i - 1]] " "]
set $var2 [string trim [string range $arg [expr $i + 1] end] " "]
} else {
if {[set tmp [faq_find [list $arg]]] != ""} {
set $var2 [lindex $tmp 0] ; # we go with the db that this topic is already stored in
} else {
set $var2 $faq_database ; # we go w/ default db
}
}
if {([set $var1 [faq_fixtopic [set $var1]]] == "") || ([set $var2] == "")} {
return "error parsing sentence"
}
return [set $var2 [faq_fixdb [set $var2]]] ; # this may return an error
}
# type = 0, returns 1/0 ; type = 1, returns proper case (or error), for use with existing topics ;
# type = 2, returns proper case (or original topic), for use with creating new topics
proc faq_exists {topic database type} {
global faq_data_$database
if {[set i [lsearch [string tolower [array names faq_data_$database]] [string tolower $topic]]] != -1} {
if {$type == 0} {
return 1
} else {
return [lindex [array names faq_data_$database] $i]
}
} else {
if {$type == 0} {
return 0
} elseif {$type == 1} {
return "error topic '$topic' does not exist in database '$database'"
} else {
return $topic
}
}
}
proc faq_write {topic database type arg host} {
global faq_data_$database
set topic [faq_exists $topic $database 2]
if {$type == "w"} {
set faq_data_${database}($topic) [list $arg]
} elseif {$type == "a"} {
lappend faq_data_${database}($topic) $arg
}
lappend faq_data_${database}($topic) "#WHOSET $host [clock seconds]"
}
proc faq_read {topic database} {
global faq_data_$database
if {[xindex [set database [faq_fixdb $database]] 0] == "error"} {
return $database
} elseif {[xindex [set topic [faq_exists $topic $database 1]] 0] == "error"} {
return $topic
} else {
return [set faq_data_${database}($topic)]
}
}
proc faq_copy {topic1 database1 topic2 database2} {
global faq_data_$database1 faq_data_$database2
if {[faq_exists $topic2 $database2 0]} {
return "error topic '$topic2' already exists in database '$database2'"
} elseif {[xindex [set output [faq_read $topic1 $database1]] 0] == "error"} {
return $output
} else {
set faq_data_${database2}($topic2) $output
}
}
proc faq_remove {topic database} {
global faq_data_$database
if {[xindex [set topic [faq_exists $topic $database 1]] 0] == "error"} {
return $topic
} else {
unset faq_data_${database}($topic)
}
}
proc faq_disp {arg database output1 output2 depth num option nick} {
global faq_max_lines
if {$depth >= 3} {
faq_msg $output1 "error recursion too deep"
return -1
}
set found 0
if {$database != ""} {
set list [list [list $database $arg]] ; # we have an exact topic/db to display
} else {
set list [list [faq_find [faq_topics $arg]]]; # find topic/db (s)
}
# note: the $list vars above needed to be padded with { } - hence the [list] 's
foreach tmp $list {
if {$tmp == ""} {
continue
}
if {!$depth} {
set num 0
}
if {[xindex [set output [faq_read [set topic [lindex $tmp 1]] [set database [lindex $tmp 0]]]] 0] == "error"} {
faq_msg $output1 $output
} else {
foreach line $output {
if {($line == "") || ([xindex $line 0] == "#WHOSET")} {
#ignore
} elseif {[xindex $line 0] == "#LINK"} {
if {[set temp [faq_disp [lindex $line 1] [lindex $line 2] $output1 $output2 [expr $depth + 1] $num 0 $nick]] > 0} {
incr num $temp
}
} elseif {[xindex $line 0] == "."} {
faq_msg $output2 [xrange $line 1 end]
incr num
} elseif {!$num} {
faq_msg $output2 "$topic - $line"
incr num
} else {
faq_msg $output2 "... $line"
incr num
}
}
if {!$num} {
faq_msg $output1 "error '$topic' exists, but is empty"
} elseif {(![string equal -nocase $output2 $output1]) && (!$depth)} {
faq_msg $output2 "(sent by $output1)"
faq_msg $output1 "sent '$topic' to $output2"
}
incr found
}
}
if {!$found} {
if {$depth > 0} {
faq_msg $output1 "error invalid link to '$arg'"
}
}
return $num
}
# End Database code
# Begin 'calc' code
proc faq_fixexpr {exp} {
global faq_const
set exp [faq_fixtopic $exp]
foreach i [array names faq_const] {
regsub -all "\%$i" $exp $faq_const($i) exp
}
return $exp
}
# End 'calc' code
# expr's abs() and int() can't handle large unsigned integers,
# these functions are just to get around this
proc faq_int {value} {
return [lindex [split $value "."] 0]
}
proc faq_abs {value} {
return [string trimleft $value "-"]
}
proc faq_absint {value} {
return [faq_int [faq_abs $value]]
}
# Begin Public binds code
proc msg_faq {nick uhost hand arg} {
pub_faq $nick $uhost $hand "" $arg
}
proc pub_faq {nick uhost hand chan arg} {
global botnick faq_dir faq_format faq_max faq_flag faq_database faq_databases faq_channel_flag
global topic topic1 topic2 database database1 database2 value
if {(![isbotnick $nick]) && (![matchattr $hand +b]) && ((($chan != "") && ([channel get $chan $faq_channel_flag])) || ($chan == ""))} {
if {[string match -nocase $botnick* $arg]} {
set arg [xrange $arg 1 end] ; # Only answer channel messages that begin with the bot's nick
} elseif {$chan == ""} {
# Answer all privmsgs
} else {
return ; # Msg isn't for us, bail out
}
set isuser [expr {[matchattr $hand $faq_flag|$faq_flag $chan] || [matchattr $hand $faq_flag]}] ; # Note that $chan might be "", so we must handle both cases
if {([validchan $chan]) && ($isuser)} {
set output1 $chan ; # The bot sends the text to the channel for users
} else {
set output1 $nick ; # Non-users get privmsg'd
}
set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
if {([lsearch -exact [split "shutup stop sh database db set learn add unset forget delete del remove rem rm erase append addon link join copy cp move mv rename ren"] [string tolower [xindex $arg 0]]] == -1) && ([set i [string last ">" $arg]] != -1)} {
# Output has been redirected
if {(!$isuser) || ([set output2 [string trim [string range $arg [expr $i + 1] end] " "]] == "")} {
set output2 $output1 ; # Error (User doesn't have access, or output was ""), so we go back to the default
}
set arg [string trim [string range $arg 0 [expr $i - 1]] " "]
}
set command [string tolower [xindex $arg 0]]
set remainder [xrange $arg 1 end]
switch -- $command {
"shutup" - "stop" - "sh" {
if {$isuser} {
if {[clearqueue help]} {
faq_msg $output2 "OK, sorry"
} else {
faq_msg $output2 "But I'm not saying anything!"
}
}
}
"database" - "db" {
if {$isuser} {
switch -- [string tolower [xindex $remainder 0]] {
"reload" {
faq_loadall $output1 $output2
}
"save" {
faq_saveall $output1 $output2
}
"list" {
set i 1
faq_msg $output2 "Loaded database(s):"
foreach database $faq_databases {
global faq_data_$database
faq_msg $output2 [format "%s %-15s %s" $i. $database #[array size faq_data_$database]]
incr i
}
faq_msg $output2 "end"
}
default {
faq_msg $output1 "error must be one of 'reload', 'save' , or 'list'"
}
}
}
}
"set" - "learn" - "add" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic value]] 0] == "error") || \
([xindex [set error [faq_write $topic $database "w" $value $nick!$uhost]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Set '$topic' in database '$database'"
faq_needsave
}
}
}
"unset" - "forget" - "delete" - "del" - "remove" - "rem" - "rm" - "erase" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic "$remainder = null" topic value]] 0] == "error") || \
([xindex [set error [faq_remove $topic $database]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Unset '$topic' in database '$database'"
faq_needsave
}
}
}
"append" - "addon" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic value]] 0] == "error") || \
([xindex [set error [faq_write $topic $database "a" $value $nick!$uhost]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Appended to '$topic' in database '$database'"
faq_needsave
}
}
}
"link" - "join" {
if {$isuser} {
if {[xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == "error"} {
faq_msg $output1 $error
} elseif {[xindex [set topic2 [faq_exists $topic2 $database2 1]] 0] == "error"} {
faq_msg $output1 $topic2 ; # check if 2nd topic exists, get proper casing too (so $topic2 not $error is used)
} elseif {[xindex [set error [faq_write $topic1 $database1 "a" [list #LINK $topic2 $database2] $nick!$uhost]] 0] == "error"} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Linked '$topic1' ($database1) to '$topic2' ($database2)"
faq_needsave
}
}
}
"copy" - "cp" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == "error") || \
([xindex [set error [faq_copy $topic1 $database1 $topic2 $database2]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Copied '$topic1' ($database1) to '$topic2' ($database2)"
faq_needsave
}
}
}
"move" - "mv" - "rename" - "ren" {
if {$isuser} {
if {([xindex [set error [faq_parsetopic $remainder topic1 topic2]] 0] == "error") || \
([xindex [set error [faq_copy $topic1 $database1 $topic2 $database2]] 0] == "error") || \
([xindex [set error [faq_remove $topic1 $database1]] 0] == "error")} {
faq_msg $output1 $error
} else {
faq_msg $output2 "Renamed '$topic1' ($database1) to '$topic2' ($database2)"
faq_needsave
}
}
}
"list" - "find" - "search" - "locate" {
set topics [faq_find2 $remainder]
switch -- [set found [llength $topics]] {
0 {
faq_msg $output1 "Found no matches to '$remainder'"
}
1 {
faq_disp [join $topics] "" $output1 $output2 0 0 0 $nick
}
default {
faq_msg $output2 "Found $found matches to '$remainder'"
set i 1
foreach topic $topics {
faq_msg $output2 "$i. [lindex $topic 1]"
if {$i >= $faq_max} {
break
}
incr i
}
faq_msg $output2 "end"
}
}
}
"whoset" {
if {[xindex [set error [faq_parsetopic "$remainder = null" topic value]] 0] == "error"} {
faq_msg $output1 $error
} elseif {[xindex [set output [faq_read $topic $database]] 0] == "error"} {
faq_msg $output1 $output
} else {
set found 0
foreach line $output {
if {[xindex $line 0] == "#WHOSET"} {
if {!$found} {
faq_msg $output2 "'$topic' (database $database) set by [xindex $line 1] on [clock format [xindex $line 2] -format $faq_format]"
incr found
} else {
faq_msg $output2 "... modified by [xindex $line 1] on [clock format [xindex $line 2] -format $faq_format]"
}
}
}
if {!$found} {
faq_msg $output1 "error could not find who set topic '$topic'"
}
}
}
default {
faq_disp $arg "" $output1 $output2 0 0 1 $nick
}
}
}
}
# End Public binds code
# Init stuff
if {[catch {package require Tcl 8.3} error]} {
putlog "error TCL v8.3 or higher is required to run this script"
return 0
}
putlog "*** LOADED: faq.tcl"
bind pubm - * pub_faq
bind msgm - * msg_faq
setudef flag $faq_channel_flag
if {![info exists faq_load]} {
faq_loadall "" ""
set faq_load 1
}
if {![info exists faq_save]} {
set faq_save 0
}
if {![string match *time_faq* [timers]]} {
timer $faq_time time_faq
}
