Brian’s Blog

#### calc.tcl v1.0.1 ###########################################################
################################################################################
## Written by:                                                                ##
##   KuNgFo0 <KuNgFo0@techmonkeys.org> (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.        ##
##                                                                            ##
## Script that can calculate just about anything ;)                           ##
##                                                                            ##
## Usage:                                                                     ##
##   To have the .calc[ulate] commands available on a channel you need to set ##
##   the channel flag +calculator from the console/partyline .                ##
##   ``.chanset #channel +calculator´´                                        ##
##                                                                            ##
## Channel Commands (available only if channel is +convert):                  ##
##   .calc[ulate] <expression>                                                ##
## Example:                                                                   ##
##   ``.calc 15*20+3´´                                                        ##
################################################################################

#### Changelog #################################################################
################################################################################
## v1.0.1                                                                     ##
## * Minor code cleanup                                                       ##
##                                                                            ##
## v1.0.0                                                                     ##
## + Initial release.                                                         ##
## * Changed the default trigger ``botname, calc[ulate]´´ to ``.calc[ulate]´´ ##
## + Added the possibility to control which channels could use the commands   ##
##   with the channel flag ``+/-calculator´´                                  ##
################################################################################


bind pub - .calc pub_calc
bind pub - .calculate pub_calc
bind msg - calc msg_calc
bind msg - calculate msg_calc

setudef flag calculator

# You shouldn't change these, however you may add additional variables
# These are used via %varname in the 'calculate' command
# Example: Mybot, calculate %pi / 2
set calc_const(pi) 3.14159265358979323846 ; # PI
set calc_const(e)  2.7182818284590452354  ; # E
set calc_const(n)  6.0221367e23           ; # Avogadro's number [1/mol]
set calc_const(R)  8.314510               ; # Universal gas constant [J/(mol*K)]
set calc_const(k)  1.380658e-23           ; # Boltzmann's constant [J/K]
set calc_const(G)  6.67259e-11            ; # Universal gravitational constant [N*m^2/kg^2]
set calc_const(h)  6.62606891e-34         ; # Planck's constant [J*s]
set calc_const(c)  2.99792458e8           ; # Speed of light [m/s]

# No more editing required

proc xrange {xr xr1 xr2} {
    return [join [lrange [split $xr] $xr1 $xr2]]
}

proc xindex {xr xr1} {
    return [join [lrange [split $xr] $xr1 $xr1]]
}

proc calc_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 calc_msg {targets arg} {
    foreach target $targets { puthelp "PRIVMSG $target :[calc_fixdata $arg $target]" }
}

proc calc_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
}

# Begin 'calc' code
proc calc_fixexpr {exp} {
    global calc_const
    set exp [calc_fixtopic $exp]
    foreach i [array names calc_const] {
        regsub -all "\%$i" $exp $calc_const($i) exp
    }
    return $exp
}
# End 'calc' code

# Begin Public binds code
proc msg_calc {nick uhost hand arg} {
    global botnick
    pub_calc $nick $uhost $hand "" $arg
}

proc pub_calc {nick uhost hand chan arg} {
    global botnick calc_flag
    if {(![isbotnick $nick]) && (![matchattr $hand +b])} {
        if {(![string match "$chan" ""]) && (![channel get $chan calculator])} {
            return 0 ; # If command comes from a channel, and that channel doesn't have +calculator then ignore
        }
        set isuser [expr {[matchattr $hand - $chan] || [matchattr $hand -]}] ; # 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
        }
        if {[set i [string last ">" $arg]] == -1} {
            set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
        } else {
            # 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 remainder [xrange $arg 0 end]

        if {$remainder == ""} {
            calc_msg $output1 "error parsing sentence"
        } elseif {[catch {expr [calc_fixexpr $remainder]} output]} {
            calc_msg $output1 "error calculating '$remainder' ($output)"
        } else {
            calc_msg $output2 "$remainder = $output"
        }
    }
}
# End Public binds code

# Init stuff
if {[catch {package require Tcl 8.2} error]} {
    putlog "error TCL v8.2 or higher is required to run this script"
    return 0
}

putlog "*** LOADED: calc.tcl"

#### convert.tcl v1.0.1 ########################################################
################################################################################
## Written by:                                                                ##
##   KuNgFo0 <KuNgFo0@techmonkeys.org> (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.        ##
##                                                                            ##
## The script converts between a number of various units, for more speficic   ##
## information on which untis you should please refer to the source of this   ##
## script.                                                                    ##
##                                                                            ##
## Usage:                                                                     ##
##   To have the .conv[ert] commands available on a channel you need to set   ##
##   the channel flag +convert from the console/partyline .                   ##
##   ``.chanset #channel +convert´´                                           ##
##                                                                            ##
## Channel Commands (available only if channel is +convert):                  ##
##   .conv[ert] <value> <unit from> to <unit to>                              ##
## Example:                                                                   ##
##   ``.conv 20 C to F´´                                                      ##
##   Converts 20 degrees Celcius to it's Fahrenheit equivilant.               ##
################################################################################

#### Changelog #################################################################
################################################################################
## v1.0.1                                                                     ##
## * Minor code cleanup                                                       ##
##                                                                            ##
## v1.0.0                                                                     ##
## + Initial release.                                                         ##
## * Changed the default trigger ``botname, conv[ert]´´ to ``.con[vert]´´     ##
## + Added the possibility to control which channels could use the commands   ##
##   with the channel flag ``+/-convert´´                                     ##
################################################################################

bind pub - .conv pub_conv
bind pub - .convert pub_conv
bind msg - conv msg_conv
bind msg - convert msg_conv

# Set the name of the channelflag used to tell whether the convert command is
# enabled or not for that specific channel.
set conv_channel_flag "convert"

setudef flag $conv_channel_flag

# Set the next line as the exec command to run the 'units' command from the shell
# Note: Not all systems will have this installed
# Set to "" to disable
set conv_units_exec "units -v"

# Conversion formulas - each array is for its own dimension (length, volume, etc).
# Each unit is converted to a standard type by multiplying the value by the factors
# below.  It is then converted from the standard type to any other unit by
# dividing the factors.  The standard unit used must be the same for everything in
# each dimension, and can be anything as long as they are the same.  I used the root
# metric units for most things (meters, liters, grams, etc).
# Note: All strings are matched as regular expressions
# * Prefix with (?c) for units that should be case sensitive
# * Prefix with (.*?) for metric units
# * Append (?:s) for units with an optional plural ending, etc
# * Only use multiplication and division in the formulas, no addition or subtraction
# * It's a very good idea to have all the formulas return values in decimal form
#   ("1" doesn't matter, though)
# Syntax:
#  name abbreviation factor
set conv_unit(length) {
    (.*?)meter(?:s)? (.*?)m 1
    inch(?:es)?      in     {2.54 / 100}
    foot|feet        ft     {2.54 / 100 * 12}
    mile(?:s)?       mi     {2.54 / 100 * 12 * 5280}
}
set conv_unit(volume) {
    (.*?)liter(?:s)? (.*?)L 1
    pint(?:s)?       pt     {3.785 / 8}
    quart(?:s)?      qt     {3.785 / 4}
    gallon(?:s)?     gal    3.785
}
set conv_unit(weight) {
    (.*?)gram(?:s)? (.*?)g 1
    ounce(?:s)?     oz     28.35
    pound(?:s)?     lbs    453.59
    ton(?:s)?       T      {453.59 * 2000}
}
set conv_unit(work) {
    (.*?)joule(?:s)?         (.*?)J      1
    (.*?)watt-?second(?:s)?  (.*?)w-?s   1
    (.*?)watt-?hour(?:s)?    (.*?)w-?hrs 3600.0
    britishthermalunit(?:s)? btu         1055.056
    calorie(?:s)?            cal         4.1868
    foot-?pound(?:s)?        ft-?lbs     1.356
    electron-?volt(?:s)?     eV          1.6021917E-19
}
set conv_unit(power) {
    (.*?)watt(?:s)? (.*?)w 1
    volt-?amp(?:s)? va     1
    horsepower      hp     746
}
set conv_unit(time) {
    (.*?)second(?:s)? (.*?)s(?:ec(?:s)?)? 1
    minute(?:s)?      min(?:s)?           60.0
    hour(?:s)?        h(?:r(?:s)?)?       {60.0 * 60}
    day(?:s)?         {}                  {60.0 * 60 * 24}
    week(?:s)?        wk(?:s)?            {60.0 * 60 * 24 * 7}
    year(?:s)?        yr(?:s)?            {60.0 * 60 * 24 * 365}
    decade(?:s)?      {}                  {60.0 * 60 * 24 * 365 * 10}
    century|centuries {}                  {60.0 * 60 * 24 * 365 * 100}
}
set conv_unit(binary) {
    option metric 2
    (.*?)byte(?:s)? (.*?)b 1
    (.*?)bit(?:s)?  {}     {1.0 / 8}
}

# Misc conversion formulas - these are types that cannot
# be converted by regular multiplication/division of factors.
# The principle is the same as the formulas above, however
# the arrays are broken down into *_from and *_to variables.
# Note: $value is used as the value being converted.
set conv_misc_from(num) {
    option metric 0
    integer|int              {} {[scan $value "%d"]}
    long                     {} {[scan $value "%u"]}
    decimal|dec|float|double {} {[scan $value "%f"]}
    octal|oct                {} {[scan $value "%o"]}
    hexadecimal|hex          {} {[scan $value "%x"]}
    binary|bin               {} {[bin2int $value]}
    ip                       {} {[ip2long $value]}
    rgb                      {} {[rgb2int $value]}
}
set conv_misc_to(num) {
    option metric 0
    integer|int              {} {[format "%d" [conv_int $value]]}
    long                     {} {[format "%u" [conv_int $value]]}
    decimal|dec|float|double {} {[format "%f" $value]}
    octal|oct                {} {[format "%o" [conv_int $value]]}
    hexadecimal|hex          {} {[format "%X" [conv_int $value]]}
    binary|bin               {} {[int2bin [conv_int $value]]}
    ip                       {} {[long2ip [conv_int $value]]}
    rgb                      {} {[int2rgb [conv_int $value]]}
}
set conv_misc_from(temperature) {
    option metric 0
    fahrenheit         F {($value - 32) * 5 / 9.0}
    kelvin             K {$value - 273.15}
    celsius|centigrade C {$value}
}
set conv_misc_to(temperature) {
    option metric 0
    fahrenheit         F {(9 / 5.0 * $value) + 32}
    kelvin             K {$value + 273.15}
    celsius|centigrade C {$value}
}

# Conversion strings to specificially ignore (that conflict with expr)
set conv_ignore {
    e abs acos asin
    atan atan2 ceil
    cos cosh double
    exp floor fmod
    hypot int log
    log10 pow rand
    round sin sinh
    sqrt srand tan
    tanh
}

# Metric conversion factors
# Note: Abbreviations are case sensitive here
# Syntax:
#  mame abbreviation factor
set conv_metric {
    Yotta Y  24
    Zetta Z  21
    Exa   E  18
    Peta  P  15
    Tera  T  12
    Giga  G  9
    Mega  M  6
    Kilo  k  3
    Hecto h  2
    Deca  dk 1

    Deci  d  -1
    Centi c  -2
    Milli m  -3
    Micro µ  -6
    Nano  n  -9
    Pico  p  -12
    Femto f  -15
    Atto  a  -18
    Zepto z  -21
    Yocto y  -24
}

proc xrange {xr xr1 xr2} {
    return [join [lrange [split $xr] $xr1 $xr2]]
}

proc anymatch {string1 string2} {
    foreach string $string2 {
        if {[lsearch -exact [string tolower $string1] [string tolower $string]] != -1} {
            return 1
        }
    }
    return 0
}

proc conv_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 conv_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 conv_msg {targets arg} {
    foreach target $targets {
        puthelp "PRIVMSG $target :[conv_fixdata $arg $target]"
    }
}

proc conv_fixexpr {exp} {
    global ib_const
    set exp [conv_fixtopic $exp]
    foreach i [array names ib_const] {
        regsub -all "\%$i" $exp $ib_const($i) exp
    }
    return $exp
}

# Begin conversion code
proc int2bin {int} {
    return [format "%s.%s.%s.%s" \
        [byte2bin [expr ($int >> 24) & 0xff]] \
        [byte2bin [expr ($int >> 16) & 0xff]] \
        [byte2bin [expr ($int >> 8)  & 0xff]] \
        [byte2bin [expr $int         & 0xff]]]
}

proc byte2bin {byte} {
    set result ""
    for {set i 0} {$i < 8} {incr i} {
        append result [expr ($byte & 128) >> 7]
        set byte [expr $byte << 1]
    }
    return $result
}

proc bin2int {bin} {
    set result 0
    for {set i 0} {$i < [string length $bin]} {incr i} {
        if {([set digit [string index $bin $i]] == 0) || ($digit == 1)} {
            set result [expr $result << 1 | $digit]
        } elseif {$digit == "."} {
            #ignore
        } else {
            set result ""
        }
    }
    return $result
}

proc ip2long {ip} {
    if {[scan $ip "%d.%d.%d.%d" a b c d] == 4} {
        foreach i "$a $b $c $d" {
            if {($i > 255) || ($i < 0)} {
                return ""
            }
        }
        set long [expr $a << 24 | $b << 16 | $c << 8 | $d]
        if {$long < 0} {
            set long [expr pow(2, 32) + $long]
        }
        return $long
    } else {
        return ""
    }
}

proc long2ip {long} {
 return [format "%d.%d.%d.%d" \
        [expr ($long >> 24) & 0xff] \
        [expr ($long >> 16) & 0xff] \
        [expr ($long >> 8)  & 0xff] \
        [expr $long         & 0xff]]
}

proc rgb2int {rgb} {
 if {[scan $rgb "%d.%d.%d" red green blue] == 3} { return [expr $red << 16 | $green << 8 | $blue << 0] } \
 else { return "" }
}

proc int2rgb {long} {
 return [format "%d.%d.%d" \
        [expr ($long >> 16) & 0xff] \
        [expr ($long >> 8)  & 0xff] \
        [expr $long         & 0xff]]
}

# expr's abs() and int() can't handle large unsigned integers,
# these functions are just to get around this
proc conv_int {value} {
    return [lindex [split $value "."] 0]
}

proc conv_abs {value} {
    return [string trimleft $value "-"]
}

proc conv_absint {value} {
    return [conv_int [conv_abs $value]]
}

proc conv_units {value type1 type2} {
    global conv_units_exec
    regsub -all {'} [conv_fixtopic $type1] {} type1
    regsub -all {'} [conv_fixtopic $type2] {} type2
    if {[catch {exec bash -c "$conv_units_exec '$value $type1' '$type2'"} output]} {
        error $output
    }
    foreach line [split $output \n] {
        if {[regexp -- {^\s*([^=]+=.+)$} $line tmp result]} {
            return $result
        }
    }
    error "unknown response from units command"
}

proc conv_scan {var_formula var_unit index} {
    global conv_ignore conv_unit
    upvar 1 $var_formula formula $var_unit unit
    set string {([a-z]+(-[a-z]+)?)}
    if {[regexp -nocase -start $index -- $string $formula a unit]} {
        if {[lsearch -exact $conv_ignore $unit] != -1} {
            # Ignore this unit and search for the next unit
            regexp -nocase -start $index -indices $string -- $formula a index
            return [conv_scan "formula" "unit" [expr [lindex $index 1] + 1]]
        } else {
            # Found unit, return ok
            return 1
        }
    }
    # No more units found
    return 0
}

# $var will be either unit, misc_from, or misc_to
proc conv {value unit var lists} {
    global conv_$var
    upvar 1 list uplist
    if {![info exists uplist]} {
        set uplist ""
    }
    set type [expr {($var == "unit") || ($var == "misc_from") ? "*" : "/"}]
    # First we check full names, then abbreviations
    foreach method {name abbv} {
        foreach list $lists {
            # Default options
            set option_absint 0
            set option_metric 1
            foreach {name abbv formula} [set conv_$var\($list)] {
                if {$name == "option"} {
                    set option_$abbv $formula
                } elseif {[regexp -nocase -- "^([set $method])\$" $unit a b prefix]} {
                    set uplist $list
                    if {([catch {expr $formula} value]) || ($value == "")} {
                        error "evaluating expression for '$unit'"
                    }
                    if {$option_absint} {
                        set value [conv_absint $value]
                    }
                    if {($option_metric) && ($prefix != "") && ([catch {expr [conv_metric $prefix $method $option_metric] $type $value} value])} {
                        error "evaluating metric conversion for '$unit'"
                    }
                    return $value
                }
            }
        }
    }
    error "unknown conversion type '$unit'"
}

# $method will be either "name" or "abbv"
# $option will be either 1 or 2
proc conv_metric {prefix method option} {
    global conv_metric
    foreach {name abbv factor} $conv_metric {
        if {(($method == "name") && ([string equal -nocase $name $prefix])) || (($method == "abbv") && ([string equal $abbv $prefix]))} {
            if {$option == 1} {
                return [expr pow(10, $factor)] ; # Regular metric
            } elseif {$option == 2} {
                return [expr pow(2, ($factor / 3 * 10))] ; # Binary conversion
            }
        }
    }
    error "unknown metric prefix"
}
# End conversion code

# Begin Public binds code
proc msg_conv {nick uhost hand arg} {
    global botnick
    pub_conv $nick $uhost $hand "" $arg
}

proc pub_conv {nick uhost hand chan arg} {
    global botnick value global conv_channel_flag
    global conv_units_exec conv_unit conv_misc_from conv_misc_to
    if {(![isbotnick $nick]) && (![matchattr $hand +b])} {
        if {(![string match "$chan" ""]) && (![channel get $chan $conv_channel_flag])} {
            return 0 ; # If command comes from a channel, and that channel doesn't have +convert then ignore
        }
        set isuser [expr {[matchattr $hand - $chan] || [matchattr $hand -]}] ; # 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
        }
        if {[set i [string last ">" $arg]] == -1} {
            set output2 $output1 ; # By default, output2 (~stdout~) goes to output1 (~stderr~)
        } else {
            # 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 remainder [xrange $arg 0 end]
        if {(([scan $remainder "%s from %s to %s" value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
            (([scan $remainder "%s from %s %s"    value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
            (([scan $remainder "%s %s to %s"      value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
            (([scan $remainder "%s %s %s"         value type1 type2] != 3) || ([anymatch [list $value $type1 $type2] {from to}])) && \
            ((([info exists value]) && ([unset value] == "")) || 1) && \
            (([scan $remainder "from %s to %s"    type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
            (([scan $remainder "from %s %s"       type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
            (([scan $remainder "%s to %s"         type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}])) && \
            (([scan $remainder "%s %s"            type1 type2] != 2) || ([anymatch [list $type1 $type2] {from to}]))} {
                conv_msg $output1 "error parsing sentence"
            } else {
                if {![info exists value]} {
                    set value 1
                }
                if {![catch {conv $value       $type1 "misc_from" [array names conv_misc_from]} type1_value]} {
                    if {[catch {conv $type1_value $type2 "misc_to"   $list} type2_value]} {
                        conv_msg $output1 "error $type2_value"
                    } else {
                        conv_msg $output2 "$value $type1 = $type2_value $type2"
                    }
                } elseif {($conv_units_exec != "") && (![catch {conv_units $value $type1 $type2} output])} {
                    conv_msg $output2 $output
                } else {
                    set type1_formula $type1
                    set type2_formula $type2
                    set found 0
                    while 1 {
                    if {[conv_scan "type1_formula" "type1_unit" 0]} {
                        if {![conv_scan "type2_formula" "type2_unit" 0]} {
                            conv_msg $output1 "error unmatched type '$type1_unit'"
                        } elseif {[catch {conv 1 $type1_unit "unit" [array names conv_unit]} type1_value]} {
                            conv_msg $output1 "error $type1_value"
                        } elseif {![regsub -nocase $type1_unit $type1_formula $type1_value type1_formula]} {
                            conv_msg $output1 "error decompiling expression '$type1_unit'"
                        } elseif {[catch {conv 1 $type2_unit "unit" $list} type2_value]} {
                            conv_msg $output1 "error $type2_value"
                        } elseif {![regsub -nocase $type2_unit $type2_formula $type2_value type2_formula]} {
                            conv_msg $output1 "error decompiling expression '$type2_unit'"
                        } else {
                            incr found
                            continue
                        }
                    } elseif {[conv_scan "type2_formula" "type2_unit" 0]} {
                        conv_msg $output1 "error unmatched type '$type2_unit'"
                    } else {
                        break
                    } ; # At the end, so stop
                    return ; # We got an error somewhere, bail out
                }
                if {!$found} {
                    conv_msg $output1 "error no conversion types found"
                } elseif {[catch {expr [conv_fixexpr "($value) * ($type1_formula) / ($type2_formula)"]} value2]} {
                    conv_msg $output1 "error evaluating expression"
                } else {
                    conv_msg $output2 "$value $type1 = $value2 $type2"
                }
            }
        }
    }
}
# 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: convert.tcl"

#### faq.tcl v1.0.0 ############################################################
################################################################################
## Written by:                                                                ##
##   KuNgFo0 <KuNgFo0@techmonkeys.org> (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