################################################################################
# 3hauka.tcl
# Copyright (c) 2001-2004
hex@faerion.oss
#
# Distribution and modification are allowed provided the authorship is preserved.
# Official website:
https://he3hauka.sourceforge.net/
#
# $Id: 3hauka.tcl,v 1.3 2004/04/14 09:53:06 vhex Exp $
#
################################################################################
namespace eval tpub {
# clear previous values
#array unset conf
#array unset channels
# file with fobrosami
set conf(fnquestions) "[file dirname [info script]]/q.txt"
# the minimum number of answers for the highscore table
but conf (minanswers) 5
# the time through which user information is erased
# from the database, if it did not answer a single question (in seconds)
set conf (maxidle) [expr 60 * 60 * 24 * 31]; # one month
# work time limitation, for example: {8-12 16-18}
set conf(timelimit) {0-24}
# bot home page address
set conf(url) "
http://www.aizawlchat.com"
# set conf(url-top) "
http://quiz.forestnet.org/top.var"
# set conf(url-cmd) "
http://quiz.forestnet.org/#commands"
# file, in which every minute the table of records is saved,
# to disable the function, just comment out the line
set conf(scoreboard) "[file dirname [info script]]/juggle.score"
#read channel settings
if {[file exists [set _fname [file dirname [info script]]/main.conf]]} {
source $_fname
}
}
#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Converting Russian text to lowercase
# proc ::tpub::tolower {text} { return [string map {? ?} [string tolower $text]] }
proc ::tpub::tolower {text} { return [string map {? ? ? ? ? ?} [string tolower $text]] }
proc ::tpub::toupper {text} { return [string map {? ? ? ? ? ?} [string toupper $text]] }
### returns the grammatical group of the number (c) s7ream
proc ::tpub::numgrp {number} { switch -glob -- "$number" { *11 {return 3} *12 {return 3} *13 {return 3} *14 {return 3} *1 {return 1} *2 {return 2} *3 {return 2} *4 {return 2} default {return 3} } }
### working with channel settings
proc ::tpub::playground {command name {option undefined}} {
variable channels
switch -exact $command {
"exists" {
return [info exists channels([string tolower $name])]
}
"check" {
if {![info exists channels([string tolower $name])]} {
putlog "milW0rm: playground: bad channel $name"
return 0
}
return [expr { [lsearch -exact [set channels([string tolower $name])] $option] == -1 ? 0 : 1 }]
}
}
}
proc :: tpub :: maskhost {uhost} {
return [::maskhost $uhost]
# regsub {(. + @) [^.] + (\ .. +)} $ uhost {\ 1 * \ 2} host
# return $host
}
proc ::tpub::getversion {} { variable conf
return "1.10"
}
# Communicate with the server
proc putout {cmd dest msg} { global botnick
set maxlen [expr 510 - [string length "$botnick![getchanhost $botnick] $cmd $dest :"]]
while {$msg != ""} {
set text [expr {[string length $msg] > $maxlen ? [string range $msg 0 [string last \040 [string range $msg 0 $maxlen]]] : $msg}]
putserv "$cmd $dest :$text"
set msg [string trim [string range $msg [string length $text] end]]
}
}
proc putmsg {nick msg} { putout PRIVMSG $nick $msg }
proc putnot {nick msg} { putout NOTICE $nick $msg }
proc putact {dest msg} { putserv "PRIVMSG $dest :\001ACTION $msg\001" }
proc putpvt {nick msg} { puthelp "PRIVMSG $nick :$msg" }
### gives the user information on the use of the command
proc ::tpub::usage {nick cmd {arg ""} {info ""}} {
set not "\002$cmd\002"
if {$arg != ""} { append not " $arg" }
if {$info != ""} { append not " - $info"}
set aliases ""
foreach item [lsort [info commands ::tpub::cmd_*]] {
if {[string match "return \\\[cmd_$cmd * * *\\\]" [string trim [info body $item]]]} { append aliases " [string range $item 12 end]" }
}
if {$aliases != ""} {
append not ". ??????:$aliases"
}
putnot $ nick "Parametrization: $ not"
return 0
}
# checking the possibility of working at the moment
proc ::tpub::checktime {} { variable conf
if {![info exists conf(timelimit)]} { return 1 }
foreach item [split $conf(timelimit)] {
# only the hour is specified, and it matches the current one
if {[string is int $item] && [expr int($item) == int([clock format [clock seconds] -format %H])]} {
return 1
}
# only the first two elements are of interest
if {![regexp {^(\d+(:\d+)?)?-(\d+(:\d+)?)?.*$} $item t1 t1 t2 t2]} {
putlog "milW0rM: wrong time interval: $item"
continue
}
# Default Interval Limits
if {$t1 == ""} { set t1 "00:00" }
if {$t2 == ""} { set t2 "24:00" }
# add the missing minutes
if {[string is int $t1]} { append t1 ":00" }
if {[string is int $t2]} { append t2 ":00" }
# Convert to normal numbers ..
set t1 [expr double([string map {: .} $t1])]
set t2 [expr double([string map {: .} $t2])]
# current time
set t [expr double([clock format [clock seconds] -format "%H.%M"]) ]
# we get, we can play further
if {$t >= $t1 && $t <= $t2} { return 1 }
}
# not one hit ..
return 0
}
# work with questions
# question rehash - analysis file with questions, remembering the addresses available
# question get - returns an unanswered question (if necessary
# calling rehash if the questions are over), in the format:
# {question {answer answer answer}}
proc ::tpub::question {cmd {text ""}} { variable conf; variable qpos
switch -exact -- [string tolower $cmd] {
"count" {
if {![info exists qpos]} { return 0 }
return [llength $qpos]
}
"rehash" {
if {[info exists qpos]} { unset qpos }
set qpos {}
set ::tpub::qcount 0
if {[catch {open $conf(fnquestions) r} fileID]} { return 0 }
while {![eof $fileID]} {
set pos [tell $fileID]
incr ::tpub::qcount
if {[set line [string trim [gets $fileID]]] == ""} { continue }
if {[string range $line 0 0] == "#"} { continue }
lappend qpos $pos
}
close $fileID
return [llength $qpos]
}
"get" {
# random question
if {![info exists qpos] || ![llength $qpos]} {
putlog "Out of questions, rehashing..."
if {![question rehash]} {
putlog "No questions available, eek."
return {}
}
}
set idx [expr int(rand() * [llength $qpos])]
set fpos [lindex $qpos $idx]
set qpos [lreplace $qpos $idx $idx]
if {[catch {open $conf(fnquestions) r} fileID]} { return {} }
seek $fileID $fpos start
set line [gets $fileID]
set line [split [string trim $line] |]
set line "[toupper [string range $line 0 0]][string range $line 1 end]"
close $fileID
return [list [lindex $line 0] [split [lrange $line 1 end] ,]]
}
"find" {
if {$text == ""} {
error "wrong # args: should be \"questions find pattern\""
}
set idx -1
if {[catch {open $conf(fnquestions) r} fileID]} { return $idx }
while {![eof $fileID]} {
if {[string range [set line [gets $fileID]] 0 0] == "#"} { continue }
incr idx
if {[lindex [split $line |] 0] == $text} {
close $fileID
return $idx
}
}
close $fileID
return -1
}
"del" {
if {$text == ""} {
error "wrong # args: should be \"questions del number\""
}
if {![string is integer $text]} {
error "bad option \"$text\": must be an integer"
}
if {[catch {open $conf(fnquestions) r+} fileID]} { return 0 }
while {![eof $fileID]} {
set pos [tell $fileID]
if {[string range [gets $fileID] 0 0] == "#"} { continue }
if {![expr int($text)]} {
puts -nonewline $fileID "#"
close $fileID
return 1
}
incr text -1
}
close $fileID
}
"add" {
if {$text == ""} {
error "" "wrong # args: should be \"questions add question test|answer|..\""
}
if {[string first | $text] == -1} {
error "" "wrong question format, must be: \002question text|answer\002[|answer|...]"
}
if {[catch {open $conf(fnquestions) a} fileID]} {
error "" "could not open questions database for writing."
}
puts $fileID " [string trim $text]"
close $fileID
}
default {
error "bad option \"$cmd\": must be rehash, get, find or del"
}
}
return 0
}
# Returns the address to add a new user
proc ::tpub::get_new_host {host} { variable conf
if {![info exists conf(static_hosts)]} {
return "*!$host"
}
foreach item $conf(static_hosts) {
if {[string match $item $host]} {
return "*!$host"
}
}
return [maskhost $host]
}
# work with users
proc ::tpub::users {cmd {text {}}} {
variable conf
switch -exact -- $cmd {
"purge" {
set killed 0
foreach hand [userlist] {
if {[set xtra [getuser $hand xtra quiz]] == ""} { continue }
# check if one has a channel record
if {[chattr $hand] != "-"} { continue }
foreach chan [array names channels] {
if {[haschanrec $hand $chan]} { continue }
}
array set usr $xtra
# linked nick, won't remove anyways
if {[info exists usr(link)]} { continue }
if {(![info exists usr(answers)] || $usr(answers) < $conf(minanswers)) || ([info exists usr(last)] && [expr [clock seconds] - $usr(last)] > $conf(maxidle))} {
incr killed
deluser $hand
}
}
return $killed
}
"list" {
# list valid users
set users {}
foreach hand [userlist] {
if {[set xtra [getuser $hand xtra quiz]] == ""} { continue }
array unset usr
array set usr $xtra
if {[info exists usr(halt)]} { continue }
if {[info exists usr(last)] && [expr [clock seconds] - $usr(last)] < 604800 && ![info exists usr(link)]} {
lappend users [list $hand $usr(score) [format %d.%08d $usr(score) [expr 999999 - $usr(answers)]]]
}
}
# sort by place and score
set sorted {}
foreach item [lsort -real -decreasing -index 2 $users] {
lappend sorted [lrange $item 0 1]
}
return $sorted
}
"exists" {
return [validuser $text]
}
"isintop" {
if {$text == ""} {
error "" "wrong # args: should be \"users isintop user\""
}
foreach item [lrange [users list] 0 4] {
if {![string compare -nocase $text [lindex $item 0]]} { return 1 }
}
return 0
}
"get" {
if {$text == ""} {
error "wrong # args: should be \"users get nick\""
}
if {![validuser $text]} {
error "no such user - $text"
}
return [getuser $text xtra quiz]
}
"set" {
if {[validuser [set hand [lindex $text 0]]]} {
setuser $hand xtra quiz [join [lrange $text 1 end]]
return 1
} else {
return 0
}
}
"check" {
if {$text == ""} {
error "wrong # args: should be \"users check hand\""
}
set hand [lindex $text 0]
if {![validuser $hand]} {
error "users check: invalid handle: $hand"
return
}
# Correction of possibly damaged records
array set data [getuser $hand xtra quiz]
if {![info exists data(score)]} { set data(score) 0 }
if {![info exists data(cont)]} { set data(cont) 0 }
if {![info exists data(quick)]} { set data(quick) 0 }
if {![info exists data(answers)]} { set data(answers) 0 }
if {![info exists data(last)]} { set data(last) [clock seconds] }
setuser $hand xtra quiz [array get data]
}
default {
error "bad option \"$cmd\": must be purge, load, save, list, get or set"
}
}
return 0
}
### returns the duration of the current round
proc ::tpub::game_time {} { variable game
if {![info exists game] || ![info exists game(started)]} { return "????? ???????" }
set taken [expr ([clock seconds] - $game(started)) / 60]
set min [expr $taken % 60]
set hrs [expr ($taken - ($taken % 60)) / 60]
if {! $ taken} {return "very short"}
set msg ""
if {$ hrs} {append msg "$ hrs [lindex {. hours hour} [numgrp $ hrs]]"}
if {$ min} {append msg "$ min [lindex {. minute minute minute} [numgrp $ min]]"}
return [string trim $msg]
}
### reaction to private
bind msgm - * ::tpub::msg_pvt
proc ::tpub::msg_pvt {nick uhost hand text} { global botnick handlen
if {[string range $text 0 0] == "!"} {
return [msg_pub $nick $uhost $hand $nick "=$botnick [string range $text 1 end]"]
}
set cmd [string tolower [lindex [split $text] 0]]
switch -exact -- $cmd {
pass {
if {[llength [split $text]] == 1} {
putmsg $ nick "Hmm? .. It is necessary so: pass the password"
return
}
set pass [lindex [split $text] end]
putlog "%$nick!$uhost% pass ..."
if {$hand == "*"} {
if {[string length $nick] > $handlen} {
putmsg $ nick "I'm too long to work with nicknames up to $ handlen characters long, so my host set me up."
return
}
if {[validuser $nick]} {
putmsg $ nick "You can not use this nickname because it's already busy.You can choose another nickname, but if this \ 226 is really yours, and I just do not recognize you, try saying: ident password."
return
}
if {![adduser $nick]} {
putmsg $ nick "Some kind of mistake ... Call the programmer!"
return
}
chpass $nick $pass
setuser $nick COMMENT "added by milW0rm"
setuser $nick HOSTS [set host *![maskhost $uhost]]
putmsg $ nick "Yeah, I wrote it like $ host, I'll now count your answers. If you need to recover from a new address, write \ 002ident password \ 002."
putlog "added user $nick with host $host"
} elseif {[passwdok $hand -]} {
chpass $hand $hand
putmsg $ nick "Yeah, I registered the password '$ hand'."
return
} elseif {[passwdok $hand [lindex [split $text] 1]] && $pass != ""} {
putlog "moo"
}
}
ident {
if {$hand != "*"} {
putmsg $ nick "And in my opinion you're \ 226 $ hand;)"
return
}
if {[llength [split $text]] != 3} {
putmsg $ nick "Not so, it's necessary: ??ident password nickname."
return
}
if {![validuser [set tnick [lindex [split $text] end]]]} {
putmsg $ nick "I do not know anyone under the nickname $ tnick ..."
return
}
if {![passwdok $tnick [lindex [split $text] 1]]} {
putmsg $ nick "Something does not seem like this is a real password ..."
putlog "%$nick!$uhost% IDENT $tnick failed!"
return
}
putmsg $ nick "Uh-huh, added [set host [maskhost $ uhost]] to your list of addresses."
setuser $tnick HOSTS $host
putlog "added mask $host to user $hand"
}
transfer {
if {$hand == "*"} {
putpvt $ nick "I do not know anything about you."
return
}
if {[passwdok $hand -]} {
putpvt $ nick "To use this command, you must first set the password to your own nickname: do this by telling me: \ 002pass password \ 002"
return
}
set thand [lindex [split $text] 2]
if {![validuser $thand]} {
putpvt $ nick "I do not know of such a user \ 226 [lindex [split $ text] 2]."
return
}
if {![string compare $hand $thand]} {
putpvt $nick ";)"
return
}
if {![passwdok $hand [lindex [split $text] 1]]} {
putpvt $ nick "Wrong password, try again, \ 002transfer the password to whom \ 002"
return
}
if {[catch {users check $thand} errmsg]} {
putpvt $ nick "Some kind of mistake, call the programmer!"
putlog "milW0rm: error in users.check: $errmsg"
return
}
array set user1 [users get $hand]
array set user2 [users get $thand]
if {[catch {
incr user2(score) $user1(score)
incr user2(answers) $user1(answers)
if {$user1(quick) < $user2(quick) && $user1(quick)} { set user2(quick) $user1(quick) }
if {$user1(cont) > $user2(cont)} { set user2(cont) $user1(cont) }
if {$user1(last) > $user2(last)} { set user2(last) $user1(last) }
catch {
if {$user2(email) == "" && $user1(email) != ""} { set user2(email) $user1(email) }
}
catch {
if {$user2(memo) == "" && $user1(memo) != ""} { set user2(memo) $user1(memo) }
}
} errmsg]} {
putpvt $ nick "Some kind of mistake, call the programmer!"
putlog "3hauka.tcl: error during transfer: $errmsg"
return
}
users set [list $hand {}]
users set [list $thand [array get user2]]
putpvt $ nick "All information has been transferred to the account of $ thand."
putlog "milW0rm: transfer from $hand to $thand completed."
}
default {
putlog "%$nick!$uhost% $cmd (what?)"
}
}
}
# procedure for clearing the responses from debris before comparing
proc ::tpub::filter {text} {
regsub -all {[;:()\[\]!?.,/\\{}]} [tolower $text] "" text;
return [string trim $text]
}
### reaction to public teams
bind pubm - * ::tpub::msg_pub
proc ::tpub::msg_pub {nick uhost hand chan text} { global botnick; variable conf
# We check the possibility of playing on this channel.
if {[string range $chan 0 0] == "#" && ![playground exists $chan]} {
return
}
# we confine ourselves to one channel
if {![playground exists $chan]} {
return
}
# code page fit (???)
set text [encoding convertfrom [encoding system] $text]
# [encoding system] == iso8859-1
# color debris removal
regsub -all {[\002\026\037]|\003\d{0,2}(,\d{0,2})?} $text "" text
# catch commands addressed by name
if {![string compare -nocase "=$botnick" [lindex [split $text] 0]]} {
set text "![join [lrange [split $text] 1 end]]"
}
# response handling
if {[string range $text 0 0] != "!"} {
variable game
if {![info exists game] || $game(chan) != $chan || ![info exists game(question)]} { return }
set game(cnt_lost) 0
set text [filter $text]
foreach answer [lindex $game(question) 1] {
if {![string compare -nocase $text [filter [join $answer]]]} {
# correct answer
if {![playground check $chan hide-answers]} {
set correct "\226 \"\2$text\2\" \226 "
} else {
set correct ""
}
# the time required for an answer
set time [expr [clock seconds] - $game(asktime)]
if {$hand == "*"} {
putmsg $ chan "\ 00310Model, $ nick! The correct answer $ {correct} was given for \ 00304 $ time \ 00310 [lindex {. second second seconds} [numgrp $ time]], but did not bring you a single point, To start, you need to register. \ 003 "
putmsg $ nick "In order to register, just say two words to me: \ 002pass password \ 002 (password come up) .This is required only once, and it is necessary so that no one can play on your behalf (and the wrong answer takes away one point, you know?). "
putmsg $ nick "You need to remember the password, nickname \ 226 too, so that when you change your address (another Internet provider will appear, for example), you did not have to start the game again first.If this is \ 226 just your case, then you can try to recover, telling me: \ 002ident password \ 002 "
putmsg $ nick "For more information about the commands I understand, see here: $ conf (url-cmd)"
} else {
users check $hand
array set usr [users get $hand]
# counting correct answers
if {$game(lst_user) == $hand} {
incr game(lst_cnt)
} else {
set game(lst_cnt) 1
set game(lst_user) $hand
}
# Extra points for blitz
if {[info exists game(blitz)]} {
incr game(points) $game(lst_cnt)
incr game(points) -1
}
if {$game(lst_cnt) > 1 && $game(lst_cnt) > $usr(cont)} {
set usr(cont) $game(lst_cnt)
set msg_cont "$ nick responds to $ game (lst_cnt) [lindex {. question of questions} [numgrp $ game (lst_cnt)]] successively!"
}
# check for the fastest response
if {$time < $usr(quick) || $usr(quick) < 1} {
set usr(quick) $time
set msg_time ", and this is your quickest response,"
} else {
set msg_time ""
}
# scoring points
incr usr(answers)
incr usr(score) $game(points)
# counting game statistics
incr game(cnt_won)
putmsg $ chan "\ 00310The young man, $ nick! The correct answer $ {correct} was given for \ 00304 $ time \ 00310 [lindex {. second second seconds} [msgid] $ msg_time and brought you \ 00304 $ game (points ) \ 00310 [lindex {. Points point points} [numgrp $ game (points)]]. \ 003 "
if {[info exists msg_cont]} {
putmsg $chan "\00310$msg_cont\003"
}
set usr(last) [clock seconds]
# store back
users set [list $hand [array get usr]]
}
unset game(question)
utimer 5 ::tpub::tmr_ask
return 0
}
}
# unrecognized answer
if {[playground check $chan nightmare] && [llength [split $text]] == 1 && ![catch {array set usr [users get $hand]}]} {
if {$game(points) == 2 && [info exists usr(score)] && $usr(score)} {
incr usr(score) -1
users set [list $hand [array get usr]]
}
}
return
}
set cmd [string tolower [string range [lindex [split $text] 0] 1 end]]
set text [join [lrange [split $text] 1 end]]
# no commands
if {[info commands ::tpub::cmd_$cmd] == ""} { return }
# user name correction (only for output to the log)
set user [expr {$hand == "*" ? "$nick!$uhost" : $hand}]
# perform ...
set status "OK"
if {[catch {::tpub::cmd_$cmd $nick $chan $text} res]} {
set status "ERROR"
putlog "3hauka.tcl: error: $res"
if {$hand != "*" && [string first o [chattr $hand]] != -1} {
global errorCode errorInfo
putnot $nick "error executing \002$cmd\002: $errorInfo"
}
set res 1
} elseif {$res == "deny"} {
set status "DENIED"
putnot $ nick "You do not have access to the team \ 002 $ cmd \ 002, you're sorry ..."
}
if {$res != 0} {
set msg "%$user% $cmd $text"
if {$status != "OK"} { append msg " -- $status" }
putlog $msg
}
}
### help
proc ::tpub::cmd_help {nick chan text} { variable conf
if {[info commands ::tpub::cmd_$text] != ""} {
return [::tpub::cmd_$text $nick ? ?]
}
set cmds ""
foreach item [lsort [info commands ::tpub::cmd_*]] {
if {![string match "return \\\[cmd_* * * *\\\]" [string trim [info body $item]]]} { append cmds " [string range $item 12 end]" }
}
putpvt $ nick "Possible commands ([llength $ cmds]): $ cmds More detailed information on each command can be obtained on request in the form \ 002! help command \ 002, as well as at $ conf (url-cmd)"
}
### dump
proc ::tpub::cmd_dump {nick chan text} {
if {$ text == "" || "$ chan $ text" == "??"} {return [use $ nick dump text "send the text directly to the server"]}
if {[string first m [chattr [nick2hand $nick]]] == -1} { return deny }
putserv $text
}
### saving user information and reading the question database
proc ::tpub::cmd_rehash {nick chan text} {
if {"$ chan $ text" == "??"} {return [usage $ nick rehash "" "updates the configuration of the bot and the script itself.) The game does not affect the game."]}
if {[string first m [chattr [nick2hand $nick]]] == -1} { return deny }
if {$text == "questions"} {
putnot $nick "rehashing questions..."
question rehash
return [cmd_next $nick $chan $text]
}
putnot $nick "rehashing..."
rehash
}
### go to another server
proc ::tpub::cmd_jump {nick chan text} {
if {"$chan $text" == "? ?" || $text == ""} { return [usage $nick jump "" "??????? ???? ?? ?????? ??????"] }
if {[string first m [chattr [nick2hand $nick]]] == -1 } { return deny }
putnot $nick "jumping..."
jump [lindex [split $text] 0]
}
### restarting the bot
proc ::tpub::cmd_restart {nick chan text} {
if {"$ chan $ text" == "??"} {return [usage $ nick restart "" "full restart of the bot, stopping the current round and saving the results."]}
if {[string first n [chattr [nick2hand $nick]]] == -1} { return deny }
restart
}
### gluing users together
proc ::tpub::cmd_append {nick chan text} {
if {[llength $ text] <2} {return [usage $ nick append "user_who user_to" "adding data about one user to another, the first is deleted"]}
if {[string first o [chattr [nick2hand $nick]]] == -1} { return deny }
set h1 [lindex [split $text] 0]
set h2 [lindex [split $text] 1]
if {![validuser $h1]} {
putnot $ nick "User $ h1 is unknown to me."
return 0
}
if {$h1 == $h2} {
putnot $ nick "Unable to connect the user to himself."
return 0
}
array set user1 [users get $h1]
array set user2 [users get $h2]
# glasses
catch { incr user2(score) $user1(score) }
# answers
catch { incr user2(answers) $user1(answers) }
# speed of response
catch { if {$user1(quick) < $user2(quick) && $user1(quick)} { set user2(quick) $user1(quick) } }
# answers in a row ..
catch { if {$user1(cont) > $user2(cont)} { set user2(cont) $user1(cont) } }
# soap
catch { if {$user2(email) == "" && $user1(email) != ""} { set user2(email) $user1(email) } }
# memo
catch { if {$user2(memo) == "" && $user1(memo) != ""} { set user2(memo) $user1(memo) } }
# the time of the last occurrence
catch { if {$user1(last) > $user2(last)} { set user2(last) $user1(last) } }
users set [list $h1 {}]
users set [list $h2 [array get user2]]
putnot $ nick "Information about the user $ h1 is deleted, all his achievements are added to the user $ h2."
}
### Renaming a user
proc ::tpub::cmd_rename {nick chan text} {
if {[llength $text] < 2} { return [usage $nick rename "nick_from nick_to" "????????? ????? ????????????."] }
if {[string first o [chattr [nick2hand $nick]]] == -1} { return deny }
set nick1 [lindex [split $text] 0]
set nick2 [lindex [split $text] 1]
if {![validuser $nick1]} {
putnot $ nick "User $ nick1 is not found."
return 0
}
if {[validuser $nick2] && [string compare -nocase $nick1 $nick2]} {
putnot $ nick "The user $ nick2 already exists."
return 0
}
chhandle $nick1 $nick2
putnot $ nick "The user $ nick1 was successfully renamed to $ nick2."
}
### getting the opa
proc ::tpub::cmd_?? {nick chan text} { return [cmd_op $nick $chan $text] }
proc ::tpub::cmd_op {nick chan text} { global botnick
if {"$ chan $ text" == "??"} {return [usage $ nick op "" "issuing operator status, if there is an appropriate access level."]}
if {![validchan $chan]} {
putnot $ nick "The! op command can only be used on the channel that I control."
return
}
if {![isop $botnick $chan]} {
putnot $ nick "Unfortunately, I do not have any opa for $ chan, I can not help it .."
return
}
if {[string first o [chattr [nick2hand $nick] $chan]] == -1} {
return deny
} else {
pushmode $ chan + o $ nick
}
}
### fixing the order in the channel
proc ::tpub::cmd_??? {nick chan text} { return [cmd_kick $nick $chan $text] }
proc ::tpub::cmd_kick {nick chan text} { global botnick
if {$ text == "" || "$ chan $ text" == "??"} {return [usage $ nick kick "nickname? reason ...?" "throw the user off the channel, arguing it with the specified comment (if there is no default comment used)"]}
if {![validchan $chan]} {
putnot $ nick "The! kick command can only be used on the channel that I control."
return
}
if {[string first o [chattr [nick2hand $nick] $chan]] == -1} { return deny }
if {![isop $botnick $chan]} {
putnot $ nick "Unfortunately, I do not have any opa on $ chan, I can not do anything."
return
}
set victim [string trim [string range $text 0 [string first \040 $text]]]
if {![string compare -nocase $victim $botnick]} {
putact $ chan "shot himself;)"
return
}
if {![string compare -nocase $victim $nick]} {
putact $chan "slaps $nick around a bit with a large trout!"
return
}
if {[set reason [string trim [string range $text [string length $victim] end]]] == ""} {
set reason "and not such a crucified ($ nick)"
}
putserv "KICK $chan $victim :$reason"
}
### topic change
proc ::tpub::cmd_topic {nick chan text} {
if {"$ chan $ text" == "??"} {return [usage $ nick topic "? text ...?" "change the topic of the channel to the specified, or its removal in case of non-indication."]}
if {[string first o [chattr [nick2hand $nick]]] == -1} { return deny }
putserv "TOPIC $chan :$text"
}
### outputting information about the bot
proc ::tpub::cmd_?????? {nick chan text} { return [cmd_version $nick $chan $text] }
proc ::tpub::cmd_version {nick chan text} { variable game; variable conf
global version tcl_patchLevel
if {[info exists game] && $chan == $game(chan)} {
putnot $ nick "milW0rm, version [getversion] .The detailed information about the script is available at \ 037 \ 00312http: //
www.aizawlchat.com/ \ 003 \ 037"
} else {
if {[info exists conf(url)]} {
set homeinfo "Detailed information is available at $ conf (url)"
} else { set homeinfo "" }
putact $chan "\226 ??? eggdrop v.[lindex $version 0] (tcl $tcl_patchLevel) + milW0rm ?????? [getversion].$homeinfo"
}
}
### a list of users
proc ::tpub::cmd_list {nick chan text} {
if {"$ chan $ text" == "??"} {return [usage $ nick list "" "get the full list of users in descending order of points."]}
if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }
if {![llength [set users [users list]]]} {
putpvt $ nick "Information about users is missing."
} else {
set lst "([llength $users])"
foreach item $users { append lst " [lindex $item 0]" }
putpvt $nick "$lst."
}
}
### deleting user information
proc ::tpub::cmd_?????? {nick chan text} { return [cmd_forget $nick $chan $text] }
proc ::tpub::cmd_forget {nick chan text} {
if {$ text == "" || "$ chan $ text" == "?"} {return [use $ nick forget "null" "???????? ?????? ?? ????????? ????????????"]}
if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }
if {![validuser $text]} {
putnot $ nick "no information about user $ user."
return 0
}
users set [list $text {}]
putact $ chan "forgot everything he ever knew about $ user"
}
### User information
proc ::tpub::cmd_raw {nick chan text} {
if {$ text == "" || "$ chan $ text" == "?"} {return [use $ nick raw "null" "receive information on the user in \" ????? \ "????"]}
if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }
if {![validuser $text]} {
putnot $ nick "The user $ text is not registered."
return 0
}
if {[set xtra [users get $text]] == ""} {
putnot $ nick "There is no information for user $ text."
return 0
}
putpvt $nick "raw($text): [join $xtra]"
}
### manual correction
proc ::tpub::cmd_set {nick chan text} {
if {[llength [split $ text]] <2} {return [usage $ nick set "nick value? value?" "Manually setting the parameters to users (the list of available parameters and values ??is available by command \ 002raw \ 002), with an unspecified value, the parameter is deleted"]}
if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }
if {![validuser [set user [lindex [split $text] 0]]]} {
putnot $ nick "User \ 002 $ user \ 002 is unknown to me."
return 0
}
set para [lindex [split $text] 1]
set data [lrange [split $text] 2 end]
array set usr [users get $user]
if {$data == ""} {
if {[info exists usr($para)]} { unset usr($para) }
putnot $ nick "The value of the $ para parameter for user $ user was deleted."
} else {
set usr($para) $data
putnot $ nick "The value of the $ para parameter for user $ user is changed to: $ data"
}
users set [list $user [array get usr]]
}
### setting notes
proc ::tpub::cmd_memo {nick chan text} {
if {$ text == "" || "$ chan $ text" == "??"} {return [usage $ nick memo "note" "setting the specified comment to your own nickname, displayed by the command \ 002! won \ 002, as well as on the channel site, if any To delete a comment, specify \ "none \". "]}
if {[set hand [nick2hand $nick]] == "*"} {
putnot "Setting a note is possible only for registered users (answer at least one question)."
return 0
}
array set user [users get $hand]
if {$text == ""} {
if {[info exists user(memo)]} {
putnot $ nick "Your note: $ user (memo)"
} else {
putnot $ nick "Note is not set."
}
return 0
} elseif {($text == "none") || ($text == "???")} {
if {[info exists user(memo)]} { unset user(memo) }
putnot $ nick "Note removed."
} else {
set user(memo) [string range $text 0 199]
putnot $ nick "Your note has been changed to: $ user (memo)"
}
users set [list $hand [array get user]]
}
### setting up e-mail
proc ::tpub::cmd_email {nick chan text} {
if {$ text == "" || "$ chan $ text" == "?"} {return [use $ nick email "address" "set up your own e-mail address to retrieve, for example, your channel"]}
if {[set hand [nick2hand $nick]] == "*" || ![validuser $hand]} {
putnot $ nick "Setting the e-mail address is only possible for registered users (for example, answering at least one question)."
return 0
}
array set user [users get $hand]
if {$text == ""} {
if {![info exists user(email)]} {
putnot $ nick "The email address is not set."
} else {
putnot $ nick "Your email address: $ user (email)"
}
return 0
} elseif {$text == "none" || $text == "???"} {
if {[info exists user(email)]} { unset user(email) }
putnot $ nick "Removed information about your email."
} else {
set user(email) [lindex [split $text] 0]
putnot $ nick "Your email address has been changed to $ user (email)"
}
users set [list $hand [array get user]]
}
### running the quiz
proc ::tpub::cmd_????? {nick chan text} { return [cmd_start $nick $chan $text] }
proc ::tpub::cmd_start {nick chan text} { variable game; variable conf
if {"$ chan $ text" == "??"} {return [usage $ nick start "" "run the quiz on the current channel, if allowed by the bot master."]}
if {[lsearch -exact [channel info $chan] "+bitch"] != -1 && [nick2hand $nick] == "*"} {
return
}
if {[info exists game]} {
if {$game(chan) == $chan} {
putnot $ nick "quiz is already running
"
} else {
putmsg $ chan "$ nick, the quiz is already running on the $ game (chan) channel, welcome;)"
}
return
}
if {![set ::tpub::qcount] && ![question rehash]} {
putmsg $ chan "$ nick, unfortunately, there are no questions in the database, the launch of the quiz is impossible ..."
return
}
if {![playground exists $chan]} {
putmsg $ chan "$ nick, you can not run a quiz on this channel."
return
}
if {![checktime]} {
putmsg $ chan "$ nick, the quiz is currently unavailable - my work time is limited by my host."
return
}
if {[set hand [nick2hand $nick]] == "*"} {
global botnick
putnot $ nick "To participate in the quiz, you need to register. You can do this with the command \ 002 / msg $ botnick PASS password \ 002, after which you can start playing again."
return
}
set modes {blitz ????}
if {$text != "" && [lsearch $modes $text] == -1} {
putmsg $ chan "$ nick, I do not know this game mode \ 226 $ text, I know: [join $ modes {,}]."
return
}
if {[lsearch -exact {blitz ????} [lindex [split $text] 0]] != -1} {
set game(blitz) 1
set what "blitz-tournament"
} else {
set what "????"
}
putmsg $ chan "\ 00310Welcome to our quiz! Start $ what.In the database [set :: tpub :: qcount] [lindex {. question of questions} [numgrp [set :: tpub :: qcount]]]. 003 "
# checking the integrity of information about the user, adding a host
users check [set hand [nick2hand $nick]]
#Initialization
set game(chan) $chan ;# ?????
set game (creator) $ hand; # user who started the game (for! stop)
set game (started) [clock seconds]; # start time of the game
set game (cnt_lost) 0; # number of lost questions
set game (cnt_won) 0; # number of correct answers
set game (qid) 0; # number of the current question
set game (lst_user) ""; # last correctly answered the question
set game (lst_cnt) 0; # the current number of correct answers in a row
# ask the first question
utimer 5 ::tpub::tmr_ask
}
### information about the current question
proc ::tpub::cmd_?????? {nick chan text} { return [cmd_repeat $nick $chan $text] }
proc ::tpub::cmd_repeat {nick chan text} { variable game
if {"$ chan $ text" == "??"} {return [usage $ nick repeat "" "prints the current question, if given."]}
if {![info exists game]} {
putmsg $ chan "$ nick, the quiz is not running - use the command \ 002! start \ 002"
return 0
}
if {![info exists game(question)]} {
putnot $ nick "the question has not been set yet."
return 0
}
putnot $ nick "current question: [lindex $ game (question) 0]"
return 0
}
### prompt request
proc ::tpub::cmd_???? {nick chan text} { return [cmd_hint $nick $chan $text] }
proc ::tpub::cmd_hint {nick chan text} { variable game
if {"$ chan $ text" == "??"} {return [usage $ nick hint "" "gives a hint on the current question, with a delay of 5 seconds, subsequent prompts are given with a delay of 20 seconds. one point from the initial cost of the question (3 points). "]}
if {![info exists game] || $game(chan) != $chan || ![info exists game(question)]} {
return 0
}
if {[info exists game(blitz)]} {
return 0
}
# search for an active prompt already
foreach item [utimers] {
if {[lrange [lindex $item 1] 0 1] == [list ::tpub::tmr_hint $game(qid)]} {
return 0
}
}
utimer 5 [list ::tpub::tmr_hint $game(qid)]
return 0
}
### skip the question
proc ::tpub::cmd_?????? {nick chan text} { return [cmd_next $nick $chan $text] }
proc ::tpub::cmd_next {nick chan text} { variable game
if {"$ chan $ text" == "?"} {return [usage $ nick next "" "skipping the current question.) The command is only available to operators, the top five players and the user who ran the quiz."]}
if {[string range $chan 0 0] != "#"} {
putlog "milW0rm: skip request from $nick ignored (not on channel)."
return
}
# Checkable, clogged game.
if {![info exists game]} {
putmsg $ chan "$ nick, the quiz is not running - use the command \ 002! start \ 002"
return
}
# can not be
if {[playground check $chan no-skip]} {
putlog "milW0rm: skip request from $nick denied (playground configuration)."
return
}
if {[string first o [chattr [nick2hand $nick $chan] [expr {[validchan $chan] ? $chan : ""}]]] == -1 && ![users isintop [set user [nick2hand $nick]]] && $game(creator) != [nick2hand $nick]} { return deny }
set game(lst_user) ""
set game(lst_cnt) 0
set game(cnt_lost) 0
if {![info exists game(question)]} { return 0 }
tmr_next $game(qid)
}
### quiz stop
proc ::tpub::cmd_???? {nick chan text} { return [cmd_stop $nick $chan $text] }
proc ::tpub::cmd_stop {nick chan text} { variable game
if {"$ chan $ text" == "?"} {return [usage $ nick stop "" "stop the current round of the quiz.) Only available to operators, the top five players and the user who ran the quiz."]}
if {![info exists game]} {
putmsg $ chan "$ nick, the quiz is not running - use the command \ 002! start \ 002"
return 0
}
if {[set user [nick2hand $nick]] != $game(creator) && [string first o [chattr [nick2hand $nick]]] == -1 && !([lsearch -exact [channel info $chan] "+bitch"] == -1 && [users isintop $user])} { return deny }
set msg "Quiz is stopped."
if {$game(qid)} {
append msg "Total [lindex {. sounded it sounded} [numgrp $ game (qid)]] $ game (qid) [lindex {. question of questions} [numgrp $ game (qid)]]"
if {$ game (cnt_won)} {append msg ", of which $ game (cnt_won) was given the correct answer." } else {append msg "." }
append msg " ???? ??????? [game_time]."
}
putmsg $chan "\00304$msg\003"
unset game
users purge
}
### output of the best players
proc ::tpub::cmd_??? {nick chan text} { return [cmd_top $nick $chan $text] }
proc ::tpub::cmd_top {nick chan text} { variable game
if {"$ chan $ text" == "??"} {return [usage $ nick top "? amount?" "output information about the best players."]}
# during the game
variable conf
if {[info exists game]} {
if {[info exists game(topsent)] && [string first m [chattr [nick2hand $nick]]] == -1} {
putlog "-- skipped --"
return
}
set game (topsent) 1
set msg ""
set place 0
foreach item [lrange [users list] 0 4] {
append msg ", #[incr place] \226 [lindex $item 0] ([lindex $item 1])"
}
set url [expr {[info exists conf (url-top)]? "More detailed statistics can be obtained at the address \ 00312 \ 037 $ conf (url-top) \ 037": "."}}]
putmsg $ chan "\ 0034 The current five leaders: [string range $ msg 2 end] $ url \ 003"
return
}
if {![llength [set users [users list]]]} {
putmsg $ chan "$ nick, the record table is empty."
return 0
}
if {[catch {set count [expr int([lindex $text 0])]}]} { set count 5 }
if {$count < 5} { set count 5 }
if {$count > 9} { set count 10}
putmsg $ chan "\ 00304 [lindex {The five of the G-Seven eight Nine Ten} [expr $ count - 5]] the best at the moment: \ 003"
set idx 1
foreach item $users {
putmsg $chan " \00304#[format %02d $idx]. [lindex $item 0] \226 \002[lindex $item 1]\002 [lindex {. ???? ???? ?????} [numgrp [lindex $item 1]]]\003"
if {[incr idx] > $count} { break }
}
# $conf(url-top)
putmsg $ chan [expr {$ idx> [llength $ users]? "\ 00304 Well, actually .And no one else has played;) \ 003": [expr {[info exists conf (url-top)]? "\ 00304More information can be obtained at the address \ 00312 \ 037 $ conf (url-top) \ 003": "\ 00304 Well, actually .And the other attention does not deserve ...
\ 003"}]}]
}
### displaying user information
proc ::tpub::cmd_??? {nick chan text} { return [cmd_won $nick $chan $text] }
proc ::tpub::cmd_won {nick chan text} { variable game
if {"$ chan $ text" == "??"} {return [usage $ nick won "? nick?" "displaying information on the specified nick, or about the current user."]}
if {[string first "f" [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1 && [info exists game]} {
if {[info exists game(wonsent)] && [lsearch $game(wonsent) $nick] != -1} {
return
}
lappend game(wonsent) $nick
}
if {$text == ""} {
set hand [nick2hand $nick]
} elseif {![validuser [set hand [lindex [split $text] 0]]]} {
set hand [nick2hand $hand]
}
if {[string is int $text] && $text != ""} {
set list [users list]
if {[expr int($text)] > [llength $list]} {
putnot $ nick "In the database of the entire [llength $ list] of the user [lindex {. her i} [numgrp [llength $ list]]]."
return 0
}
set hand [lindex [lindex $list [expr int($text) - 1]] 0]
}
if {$hand == "" || $hand == "*"} {
if {$text == ""} {
putnot $ nick "No information about you, can you play?;)"
} else {
putnot $ nick "User $ text is unknown to me ..."
}
return 0
}
array set user [set xtra [users get $hand]]
set place -1
if {![info exists list]} { set list [users list] }
for {set i 0} {$i < [llength $list]} {incr i} {
if {![string compare -nocase $hand [lindex [lindex $list $i] 0]]} {
set place $i
break
}
}
incr place
if {$xtra == ""} {
putnot $ nick "I do not have any information about user $ hand."
return 0
}
set msg "In the $ hand account, already $ user (answers) [lindex {. answer response} [numgrp $ user (answers)]] ($ user (score) [lindex {point points}} [numgrp $ user (score )]]) "
if {$user(cont) > 1} {
append msg ", the best result is \ 226 $ user (cont) [lindex {. answer response} [numgrp $ user (cont)]]
}
append msg ", the fastest response was given for $ user (quick) [lindex {. second second seconds} [numgrp $ user (quick)]]"
if {[info exists user(memo)]} {
append msg " (??????????: $user(memo))"
}
if {$place} {
set honor [expr {$place < 6 ? " ????????" : ""}]
append msg "." $ hand $ honor $ place-is place "
}
putmsg $chan "\00302$msg.\003"
}
### game statistics
proc ::tpub::cmd_???? {nick chan text} { return [cmd_stat $nick $chan $text] }
proc ::tpub::cmd_stat {nick chan text} { variable game
if {"$ chan $ text" == "??"} {return [usage $ nick stat "" "displays information about the current game, and statistics on the database of questions."]}
set usercount [llength [users list]]
set msg "The database contains [set :: tpub :: qcount] [lindex {. question of questions} [numgrp [set :: tpub :: qcount]]], of which [set count [question count] is not yet [ [numgrp $ count]]. [lindex {. registered registered registered} [numgrp $ usercount]] $ usercount [lindex {. user of users} [numgrp $ usercount]] "
if {[info exists game]} {
if {$chan != $game(chan)} {
append msg. "At the moment, the quiz is running on the $ game (chan) channel"
}
append msg. "In total, [lindex {.Sound sounded like this}} [numgrp $ game (qid)]] $ game (qid) [lindex {. question of questions} [numgrp $ game (qid)]], of which $ game (cnt_won) was given the correct answer.The game lasts [game_time] "
if {[info exists game(creator)]} {
append msg ", and was started by the command $ game (creator)"
}
}
putmsg $chan "\0034$msg.\003"
}
### distributing crosses inbound
bind join - * ::tpub::on_join
proc ::tpub::on_join {nick uhost handle chan} { variable game; variable conf
if {![playground exists $chan] || $handle == "*"} { return }
array set usr [users get $handle]
if {[users isintop $handle]} {
# if {$usr(score) > 100} { pushmode $chan +v $nick }
if {[lsearch -exact [channel info $chan] "+greet"] != -1 && [info exists usr(memo)]} { putmsg $chan "\[\002$nick\002\] $usr(memo)" }
}
set not ""
if {[info exists game]} {
set not "The current round lasts [game_time]"
if {[info exists game(question)]} {
append not ", ??????: \"[lindex $game(question) 0]\""
} else { append not "." }
}
if {$not != ""} { putnot $nick $not }
}
### issue of the next question
### 123456
proc ::tpub::tmr_ask {} { variable game
if {![info exists game] || [info exists game(question)]} { return }
if {[info exists game(topsent)]} {
unset game (topsent)
}
set game(question) [question get]
set game(points) 3
set game(asktime) [clock seconds]
incr game(qid)
putmsg $game(chan) "\00302[lindex $game(question) 0]\003"
utimer [expr {[info exists game(blitz)] ? 20 : 60}] [list ::tpub::tmr_next $game(qid)]
}
### issue the next question
proc ::tpub::tmr_next {qid} { variable game
if {![info exists game] || ![info exists game(question)] || $qid != $game(qid)} { return }
# reset the number of answers "in a row"
set game(lst_user) ""
set game(lst_cnt) 0
if [info exists game(topsent)] { unset game(topsent) }
if [info exists game(wonsent)] { unset game(wonsent) }
# check if we are outside the specified time frame
set ct [checktime]
# number of lost questions
if {!$ct || [incr game(cnt_lost)] == 3} {
if {$game(cnt_lost) == 3} {
set msg "The game is stopped due to lack of interest in it"
} else {
set msg "The game is stopped due to the time constraints"
}
if {$ game (qid)} {append msg ". Total [lindex {.Sound sounded} {numgrp $ game (qid)]] $ game (qid) [lindex {question} [numgrp $ game (qid )]], "}
if {$game(cnt_won)} {
append msg "of which $ game (cnt_won) was given the correct answer."
} else {
append msg "no correct answers were received."
}
putmsg $game(chan) "\00304$msg ???? ??????? [game_time].\003"
unset game
return
}
putmsg $ game (chan) "\ 00303No person answered the question after 5 seconds. \ 003"
unset game(question)
utimer 5 ::tpub::tmr_ask
}
### issuing prompts
proc ::tpub::tmr_hint {qid {len 2}} { variable game
if {![info exists game] || ![info exists game(question)] || $qid != $game(qid)} { return }
if {![incr game(points) -1]} {
tmr_next $qid
return
}
set answer [join [lindex [lindex $game(question) 1] 0]]
if {$len >= [string length $answer]} { return }
putmsg $game(chan) "\00312?????????:\00302 [string range $answer 0 [expr $len - 1]]...?\003"
utimer 20 [list ::tpub::tmr_hint $game(qid) [incr len]]
}
### initialization
namespace eval tpub {
if {![set count [question count]]} { set count [question rehash] }
putlog "milW0rm-[getversion] here, $qcount [lindex {. question questions questions} [numgrp $qcount]], $count cached left."
}
# hint
bind dcc m hint ::tpub::dcc_hint
proc ::tpub::dcc_hint {hand idx text} { variable game
if {![info exists game]} {
putidx $idx "Game is not started."
return
}
if {![info exists game(question)]} {
putidx $idx "Question isn't known yet."
return
}
if {[info exists game(blitz)]} {
putidx $idx "Uh-oh, it's a blitz!.."
return
}
putidx $idx "Current answers: [string map {? ?} [lindex $game(question) 1]]"
}
# User information
bind dcc m won ::tpub::dcc_won
proc ::tpub::dcc_won {hand idx text} {
if {![string length $text]} {
putidx $idx "Usage: won <nick>"
return
}
if {![validuser [set nick [lindex [split $text] 0]]]} {
putidx $idx "Can't find anyone with such a nick."
return
}
array set user [set xtra [users get $nick]]
if {$xtra == ""} {
putidx $idx "User $nick is not known to have played quiz."
} elseif {[catch {
putlog "#$hand# won $nick"
# count place number
set place -1
for {set list [users list]; set i 0} {$i < [llength $list]} {incr i} {
if {![string compare -nocase $nick [lindex [lindex $list $i] 0]]} {
set place $i
break
}
}
incr place
set fame [expr {$place ? ", place: $place" : ""}]
putidx $idx "User: $nick, score: $user(score), answers: $user(answers) (max: $user(cont)), speed: $user(quick) sec.$fame"
if {[info exists user(memo)]} {
putidx $idx "$nick has a memo: [string map {? ?} $user(memo)]"
}
}]} { putidx $idx "Error displaying information for $nick, try: .tcl getuser $nick xtra quiz" }
return 0
}
# Userlist
bind dcc m score ::tpub::dcc_score
proc ::tpub::dcc_score {hand idx text} { variable game
set fname [lindex [split $text] 1]
switch -exact -- [lindex [split $text] 0] {
"export" {
if {$fname == ""} {
putidx $idx "Usage: .score export filename"
return 0
}
if {[catch {open $fname w} fileID]} {
putidx $idx "Failed to open $fname for writing."
return 0
}
set count 0
foreach user [lsort [userlist]] {
if {[set xtra [getuser $user xtra quiz]] == ""} { continue }
puts $fileID "$user $xtra"
incr count
}
close $fileID
putidx $idx "$count record(s) exported to $fname"
putcmdlog "#[idx2hand $idx]# score export $fname"
}
"import" {
if {$fname == ""} {
putidx $idx "Usage: .score import filename"
return 0
}
if {[catch {open $fname r} fileID]} {
putidx $idx "Failed to open $fname for reading."
return 0
}
# remove old records
foreach item [userlist] { setuser $item xtra quiz }
set count 0
set fails 0
while {![eof $fileID]} {
if {[set line [string trim [gets $fileID]]] == ""} { continue }
if {![validuser [set user [lindex [split $line] 0]]]} {
incr fails
} else {
setuser $user xtra quiz [join [lrange [split $line] 1 end]]
incr count
}
}
close $fileID
putidx $idx "$count record(s) imported, $fails failed to import."
putcmdlog "#[idx2hand $idx]# score import $fname"
}
default {
putidx $idx "Usage: .score {import|export} filename"
return 0
}
}
}
# Periodic saving of results
if {[info exists ::tpub::conf(scoreboard)]} {
bind time - "* * * * *" ::tpub::tmr_dump
} else {
catch { unbind time - "* * * * *" ::tpub::tmr_dump }
}
proc ::tpub::tmr_dump {minute hour day month year} { variable conf
if {[catch {open $conf(scoreboard) w} out]} { return }
foreach user [lsort [userlist]] {
if {[set xtra [getuser $user xtra quiz]] == ""} { continue }
puts $out "$user $xtra"
}
close $out
}
# disable eggdrop's built-in help
# unbind msg - help *msg:help
