source: scripts/karma.tcl @ 46

# Karma v.06
#

# Script needs mc.main.tcl
if {$moretools < "010108"} { die "Karma.tcl requires mc.main.tcl version > 010108" }

# 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

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;
}

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"
        }
}

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"
}

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 ] 
}


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)"
                # 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 {$karmalist($karmaitem) == "2000"} {
                        # 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 $karmalist($karmaitem) helemaal naar de 2000 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]]
}