karma.tcl

# Karma v.07
#

# Script needs mc.main.tcl (for using 'filt')
if {$moretools < "010108"} { die "Karma.tcl requires mc.main.tcl version > 010108" }
# Script also needs mc.more_tools.tcl (for using 'filter')
if {([lindex [array get mc_moretools loaded]] == "1") && $mc_moretools(numversion) < "003001000"} { die "Karma.tcl requires mc.more_tools.tcl version > 003001000" }


# Where's the data file?
set karma(datfile) "scripts/karma.dat"
# To debug or not to debug
set karma(debug) 1
# counter for the anti-flood
set karma(lasttime) [expr 60+[rand 91]]
# maximum of karma's being set by a use in $karma(lasttime)
set karma(maxcount) 3
# Maximum of karma's displayed when matching
set karma(maxmatch) 15

bind pubm -|- "*\-\-*" karma_action
bind pubm -|- "*\+\+*" karma_action
bind pub - !karma karma_get
bind pub - !karmamatch karma_match
bind pub - !karmatop karma_top
setudef flag karma

# Just a normal karma request
proc karma_get { nick host hand chan args } {
    # Check if karma is enabled on this chan
    if {[lsearch [channel info $chan] -karma] != -1} {
        return 0
    }
    global karma
    # remove trailing whitespace from arguments
    set args [string trim [join $args]]
    # if there arent any args, set args to nickname
    if {$args == ""} {
        set args $nick
    }
    # read the karmafile
    set fs [open $karma(datfile) r]; set init 0;
    while {![eof $fs]} { set karmalist($init) [gets $fs]; incr init; }
    close $fs;
    set hoev_karma 0
    # search for the requested karma
    foreach e [lsort [array names karmalist]] {
        set blub [split $karmalist($e) #]
        if {[string tolower $args]==[lindex $blub 0]} { set hoev_karma [lindex $blub 1]; }
    }
    putquick "PRIVMSG $chan :args has a karma of: $hoev_karma"
    # putquick "PRIVMSG $chan :$args heeft een karma van: $hoev_karma"
    return 0;
}

# Search for certain karma's with globbing matching
proc karma_match { nick host hand chan args } {
    # Check if karma is enabled on this chan
    if {[lsearch [channel info $chan] -karma] != -1} {
            return 0
    }
    global karma
    # remove trailing whitespace from arguments
    set args [string trim [filt [join $args]]]
    # read the karmafile
    set fs [open $karma(datfile) r]; set init 0;
    while {![eof $fs]} { set karmalist($init) [gets $fs]; incr init; }
    close $fs;
    set init 0
    # search for the requested karma
    foreach e [lsort [array names karmalist]] {
        set blub [split $karmalist($e) #]
        if {[string match -nocase $args [lindex $blub 0]]} { set match($init) $karmalist($e); incr init; }
    }
    if {[array size match] > $karma(maxmatch)} {
        putquick "PRIVMSG $chan :$args has too many results ([array size match]), improve your request"
        # putquick "PRIVMSG $chan :$args leverde teveel resultaten ([array size match]), verbeter je zoekopdracht"
        return 0
    } elseif {[array size match] == 0} {
        putquick "PRIVMSG $chan :$args didn't have any results, too bad!"
        # putquick "PRIVMSG $chan :$args leverde helemaal geen resultaten, jammer joh!"
        return 0
    } else {
        set output ""
        foreach m [array names match] {
            set bla [split $match($m) #]
            set output "$output ([lindex $bla 0]: [lindex $bla 1])"
        }
        putquick "PRIVMSG $chan :Karma's ([array size match]/[array size karmalist]):$output"
    }
}

# Gets the top&bottom 5 of karma's.
proc karma_top { nick host hand chan args } {
    # Check if karma is enabled on this chan
    if {[lsearch [channel info $chan] -karma] != -1} {
        return 0
    }
    global karma
    # read the karmafile
    set fs [open $karma(datfile) r]; set init 0;
    while {![eof $fs]} { set karmalist($init) [gets $fs]; incr init; }
    close $fs;
    # turn around the data, i.e. karma#111 -> 111 karma
    foreach e [lsort [array names karmalist]] {
        set blub [split $karmalist($e) #]
        lappend karmastack "[lindex $blub 1] [list [lindex $blub 0]]"
        # putloglev 8 * "[lindex $blub 1] [lindex $blub 0]"
    }
    # sort the list to get the highest number on top
    set karmastack [lsort -decreasing -dictionary $karmastack]
    set output "Karma top 5:"
    for {set init 0} {$init<5} {incr init} {
        set karmaoutput [lindex $karmastack $init]
        set output "$output ([lindex $karmaoutput 1]: [lindex $karmaoutput 0])"
    }
    # now turn it around and get the bottom numbers
    set output "$output // Karma bottom 5:"
    set karmastack [lsort -command compare $karmastack]
    for {set init 1} {$init<6} {incr init} {
        set karmaoutput [lindex $karmastack $init]
        set output "$output ([lindex $karmaoutput 1]: [lindex $karmaoutput 0])"
    }
    putquick "PRIVMSG $chan :$output"
}

# What's better, koffie or bier?
# FIXME: complete this!
proc karma_vs { nick host hand chan args } {
        # Check if karma is enabled on this chan
        if {[lsearch [channel info $chan] -karma] != -1} {
                return 0
        }
        global karma
        # read the karmafile
        set fs [open $karma(datfile) r]; set init 0;
        while {![eof $fs]} { set karmalist($init) [gets $fs]; incr init; }
        close $fs;
    set karma1 [lrange ]
}

# Get a random karma, just for fun's sake.
proc karma_random { nick host hand chan args } {
        # Check if karma is enabled on this chan
        if {[lsearch [channel info $chan] -karma] != -1} {
                return 0
        }
        global karma
        # read the karmafile
        set fs [open $karma(datfile) r]; set init 0;
        while {![eof $fs]} { set karmalist($init) [gets $fs]; incr init; }
        close $fs;
    # fetch a random item
    # [expr {int(rand()*[llength $data])}]
}

# The main proc, here's where karma in- or decreases
proc karma_action { nick host hand chan args } {
    if {[lsearch [channel info $chan] -karma] != -1} { return 0 }
    global karma karmalast karmacount;
    set plusmin "0";
    set args [string tolower [filter -- $args]];
    if {$karma(debug)} { putloglev 8 * "\[karma_debug\] args = $args" }
    set fs [open $karma(datfile) r];
    while {![eof $fs]} { set line [split [gets $fs] "#"]; set karmalist([lindex $line 0]) [lindex $line 1]; }
    close $fs;
    if {[array size karmalist] == 0} { putloglev 6 * "\[karma\] ERROR: karmalist is empty, something went wrong!"; return 0 }

    if {[llength [set inline [regexp -inline -- {([\w\-]+([\\]+ [^ ]+)*)(\+\+|\-\-)|(\w\-+)(\+\+|\-\-)|\\\[(.+)([^\\\#]+)*\\\](\+\+|\-\-)} $args]]] != 0} {

        if {[set karmaitem [lindex $inline 1]] == "" && [set karmaitem [lindex $inline 6]] == ""} {
            putloglev 6 * "\[karma\] ERROR: karmaitem not set! inline = $inline"; return 0
        };
        # I don't like the double join, but otherwise karmaitem would have a backslash (when spaces were escaped)
        set karmaitem [join [join $karmaitem]]
        # FIXME: This should be replaced by a better ignore system (user had Grolsch++ in his 'now playing' script, which was annoying)
        #if {([maskhost $nick!$host] == "*!Lup@*.rug.nl" || [maskhost $nick!$host] == "*!Lup@129.125.133.*") && $karmaitem == "grolsch"} { return 0 }

        if {[array get karmalast $host%$karmaitem] != ""} {
            if {[expr [lindex $karmalast($host%$karmaitem) 0]+$karma(lasttime)] > [unixtime]} { return 0 }
        } else { set karmalast($host%$karmaitem) [unixtime] }

        if {[array get karmacount $host] != ""} {
            if {[lindex $karmacount($host) 0] > $karma(maxcount)} { return 0 } else { set karmacount($host) [join [expr $karmacount($host)+1] [unixtime]]}
        } else { set karmacount($host) [join 1 [unixtime]]}

        if {$karma(debug)} { putloglev 8 * "\[karma_debug\] karmacount($host) = $karmacount($host)" }

        if {[string match "*\+\+" [lindex $inline 0]]} {
            set plusmin "+1"
                if {$karmaitem == [string tolower $nick]} {
                # You can put a penalty in the setting below, when someone karma's himself.
                set plusmin "0"
                putquick "PRIVMSG $chan :$nick\: trying to put your ego up, ey?! Guess what, you just lost"
                    # putquick "PRIVMSG $chan :$nick\: Jij egoslet! Beetje je eigen karma ophogen, tss :p (U heeft zojuist verloren...)"
            }
        } elseif {[string match "*\-\-" [lindex $inline 0]]} {
            set plusmin "-1"
        } else {
            putloglev 6 * "\[karma\] ERROR: string match did not match \+\+ nor \-\-"; return 0
        }
        set karmaitem [join $karmaitem]

        if {$karma(debug)} { putloglev 8 * "\[karma_debug\] plusmin = $plusmin !! karmaitem = $karmaitem" }

        if {[llength [array get karmalist $karmaitem]] == 2 } {
            set karmalist($karmaitem) "[expr $karmalist($karmaitem) $plusmin]"
        } else {
            set karmalist($karmaitem) "[expr 0 $plusmin]"
        }
        putloglev 6 * "\[karma\] $chan <$nick> set karmalist($karmaitem) $karmalist($karmaitem)"

        # putquick "PRIVMSG $chan :$nick heeft de karma van $karmaitem veranderd naar $karmalist($karmaitem)"

        # FIXME: This is added just for the karma of 'koffie', it might be more fun if there would be a system that has certain degrees or smth.
        if {[regexp {^[1-9]\.0$} [expr $karmalist($karmaitem)/1000.0]]} {
            putquick "PRIVMSG $chan :WOW $nick, you just had the questionable honor of putting the karma of $karmalist($karmaitem) to 2000! Congratulations! Buy everyone a beer on this occasion, will you?"
            #putquick "PRIVMSG $chan :WOW $nick, jij hebt de twijfelachtige eer om de karma van $karmaitem helemaal naar $karmalist($karmaitem) te krijgen! GEFELICITEERD! Trakteer jij even iedereen bier?"
        }
        set fs [open $karma(datfile) w]
        foreach item [lsort [array names karmalist]] {
            if {$karmalist($item)!=""} { puts $fs [join [list $item [lindex $karmalist($item) 0]] "#"] }
            }
        close $fs;
    } else {
        putloglev 6 * "\[karma\] We are triggerd, but filtered by regexp."
    }
}

bind pub n !karmatest karma_test
proc karma_test {nick host hand chan args} {
    set args [string tolower [filter -tcl $args]];
    putserv "privmsg $chan :$args"
    set inline [regexp -inline -- {([\w\-]+([\\]+ [^ ]+)*)(\+\+|\-\-)|(\w\-+)(\+\+|\-\-)|\\\[(.+)([^\\\#]+)*\\\](\+\+|\-\-)} $args]
    putserv "privmsg $chan :$inline"
    putserv "privmsg $chan :[join [join [lindex $inline 1]]]"
}


proc clean_karmalast {} {
    global karmalast
    foreach {akey} [array names karmalast] {
        if {[expr [lindex $karmalast($akey) 0]+120] < [unixtime]} { unset karmalast($akey) }
    }
    if {![string match *clean_karmalast* [utimers]]} { utimer 60 clean_karmalast }
}

proc clean_karmacount {} {
    global karmacount
    foreach akey [array names karmacount] {
        if {[expr [lindex $karmacount($akey) 1]+120] < [unixtime]} { unset karmacount($akey) }
    }
    if {![string match *clean_karmacount* [utimers]]} { utimer 60 clean_karmacount }
}

if {![string match *clean_karmalast* [utimers]]} { utimer 60 clean_karmalast }
if {![string match *clean_karmacount* [utimers]]} { utimer 60 clean_karmacount }

# debugging stuff
proc compare {a b} {
    set a0 [lindex $a 0]
    set b0 [lindex $b 0]
    if {$a0 < $b0} {
        return -1
    } elseif {$a0 > $b0} {
        return 1
    }
    return [string compare [lindex $a 1] [lindex $b 1]]
}