################################################################################
# 3hauka.tcl
# Copyright (c) 2001-2004 hex@faerion.oss
#
# Распространение и модификация допускаются при условии сохранения авторства.
# Официальный сайт: https://he3hauka.sourceforge.net/
#
# $Id: 3hauka.tcl,v 1.3 2004/04/14 09:53:06 vhex Exp $
#
################################################################################

namespace eval tpub {
	# очистка предыдущих значений
	array unset conf
	array unset channels

	# файл с фопросами
	set conf(fnquestions) "[file dirname [info script]]/3hauka.txt"

	# минимальное количество ответов для таблицы рекордов
	set conf(minanswers) 5

	# время, через которое информация о пользователе стирается
	# из базы данных, если он не отвечал ни на один вопрос (в секундах)
	set conf(maxidle) [expr 60 * 60 * 24 * 31] ;# один месяц

	# ограничение времени работы, например: {8-12 16-18}
	set conf(timelimit) {0-24}

	# адрес домашней страницы бота
	set conf(url) "http://he3hauka.sourceforge.net"
	# set conf(url-top) "http://quiz.forestnet.org/top.var"
	# set conf(url-cmd) "http://quiz.forestnet.org/#commands"

	# файл, в который каждую минуту сохраняется таблица рекордов,
	# для отключения функции достаточно закомментировать строку
	set conf(scoreboard) "[file dirname [info script]]/3hauka.score"

	# читаем настройки каналов
	if {[file exists [set _fname [file dirname [info script]]/3hauka.conf]]} {
		source $_fname
	}
}

#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

### Преобразование русского текста к нижнему регистру
# 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]] }

### возвращает грамматическую группу числа (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} } }

### работа с настройками каналов
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 "he3hauka.tcl: 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"
}

# Общение с сервером
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" }

### выдаёт пользователю информацию по использованию команды
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 "Параметризация: $not"
	return 0
}


# проверка возможности работы на данный момент
proc ::tpub::checktime {} { variable conf
	if {![info exists conf(timelimit)]} { return 1 }

	foreach item [split $conf(timelimit)] {
		# указан только час, и он совпадает с текущим
		if {[string is int $item] && [expr int($item) == int([clock format [clock seconds] -format %H])]} {
			return 1
		}

		# интересуют только первые два элемента
		if {![regexp {^(\d+(:\d+)?)?-(\d+(:\d+)?)?.*$} $item t1 t1 t2 t2]} {
			putlog "he3hauka: wrong time interval: $item"
			continue
		}

		# границы интервала по умолчанию
		if {$t1 == ""} { set t1 "00:00" }
		if {$t2 == ""} { set t2 "24:00" }

		# добавляем недостающие минуты
		if {[string is int $t1]} { append t1 ":00" }
		if {[string is int $t2]} { append t2 ":00" }

		# конвертируем в обычные числа..
		set t1 [expr double([string map {: .} $t1])]
		set t2 [expr double([string map {: .} $t2])]

		# текущее время
		set t [expr double([clock format [clock seconds] -format "%H.%M"]) ]

		# попадаем, можно играть дальше
		if {$t >= $t1 && $t <= $t2} { return 1 }
	}

	# ни одного попадания..
	return 0
}

# работа с вопросами
# question rehash - аналицизуер файл с вопросами, запоминая адреса доступных
# question get - возвращает ещё не задававшийся вопрос (при необходимости
#                вызывая rehash, если вопросы кончились), в формате:
#                {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
}


# Возвращает адрес для добавления нового пользователя
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]
}


# работа с пользователями
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
			}

			# коррекция возможно повреждённых записей
			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
}


### возвращает длительность текущего раунда
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 "очень недолго" }

	set msg ""
	if {$hrs} { append msg " $hrs [lindex {. час часа часов} [numgrp $hrs]]" }
	if {$min} { append msg " $min [lindex {. минуту минуты минут} [numgrp $min]]" }
	return [string trim $msg]
}


### реакция на приват
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 "Хм?..  Надо так: pass пароль"
				return
			}

			set pass [lindex [split $text] end]

			putlog "%$nick!$uhost% pass ..."

			if {$hand == "*"} {
				if {[string length $nick] > $handlen} {
					putmsg $nick "Слишком длинный ник.  Я могу нормально работать с никами до $handlen символов длинной, так меня настроил мой хозяин."
					return
				}
				if {[validuser $nick]} {
					putmsg $nick "Ты не можешь использовать этот ник, т.к. он уже занят.  Можешь выбрать другой ник, но если этот \226 действительно твой, и я тебя просто не узнаю, попробуй сказать: ident пароль."
					return
				}
				if {![adduser $nick]} {
					putmsg $nick "Какая-то ошибка...  Зови программиста!"
					return
				}
				chpass $nick $pass
				setuser $nick COMMENT "added by 3hauka.tcl"
				setuser $nick HOSTS [set host *![maskhost $uhost]]
				putmsg $nick "Угу, записал как $host, буду теперь засчитывать твои ответы.  Если понадобится восстановиться с нового адреса, пиши \002ident пароль\002."
				putlog "added user $nick with host $host"
			} elseif {[passwdok $hand -]} {
				chpass $hand $hand
				putmsg $nick "Угу, прописал пароль '$hand'."
				return
			} elseif {[passwdok $hand [lindex [split $text] 1]] && $pass != ""} {
				putlog "moo"
			}
		}
		ident {
			if {$hand != "*"} {
				putmsg $nick "А по-моему ты \226 $hand ;)"
				return
			}
			if {[llength [split $text]] != 3} {
				putmsg $nick "Не так.  Надо: ident пароль ник."
				return
			}
			if {![validuser [set tnick [lindex [split $text] end]]]} {
				putmsg $nick "Не знаю никого под ником $tnick..."
				return
			}
			if {![passwdok $tnick [lindex [split $text] 1]]} {
				putmsg $nick "Что-то не похоже это на настоящий пароль..."
				putlog "%$nick!$uhost% IDENT $tnick failed!"
				return
			}
			putmsg $nick "Угу, добавил [set host [maskhost $uhost]] в список твоих адресов."
			setuser $tnick HOSTS $host
			putlog "added mask $host to user $hand"
		}
		transfer {
			if {$hand == "*"} {
				putpvt $nick "Ничего о тебе не знаю."
				return
			}

			if {[passwdok $hand -]} {
				putpvt $nick "Для использования этой команды нужно сперва установить пароль на собственный ник.  Сделать это можно сказав мне: \002pass пароль\002"
				return
			}

			set thand [lindex [split $text] 2]

			if {![validuser $thand]} {
				putpvt $nick "Не знаю такого пользователя \226 [lindex [split $text] 2]."
				return
			}

			if {![string compare $hand $thand]} {
				putpvt $nick ";)"
				return
			}

			if {![passwdok $hand [lindex [split $text] 1]]} {
				putpvt $nick "Неверный пароль.  Попробуй ещё раз, \002transfer пароль кому\002"
				return
			}

			if {[catch {users check $thand} errmsg]} {
				putpvt $nick "Какая-то ошибка, зови программиста!"
				putlog "3hauka.tcl: 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 "Какая-то ошибка, зови программиста!"
				putlog "3hauka.tcl: error during transfer: $errmsg"
				return
			}

			users set [list $hand {}]
			users set [list $thand [array get user2]]

			putpvt $nick "Вся информация переведена на счёт пользователя $thand."
			putlog "3hauka.tcl: transfer from $hand to $thand completed."
		}
		default {
			putlog "%$nick!$uhost% $cmd (what?)"
		}
	}
}


# процедура очистки ответов от мусора перед сравнением
proc ::tpub::filter {text} {
	regsub -all {[;:()\[\]!?.,/\\{}]} [tolower $text] "" text;
	return [string trim $text]
}

### реакция на публичные команды
bind pubm - * ::tpub::msg_pub
proc ::tpub::msg_pub {nick uhost hand chan text} { global botnick; variable conf
	# Проверяем возможность игры на этом канале.
	if {[string range $chan 0 0] == "#" && ![playground exists $chan]} {
		return
	}

	# ограничиваемся одним каналом
	if {![playground exists $chan]} {
		return
	}

	# подгонка кодовой страницы (???)
	set text [encoding convertfrom [encoding system] $text]
	# [encoding system] == iso8859-1

	# удаление цветного мусора
	regsub -all {[\002\026\037]|\003\d{0,2}(,\d{0,2})?} $text "" text

	# ловим команды, адресованые по имени
	if {![string compare -nocase "=$botnick" [lindex [split $text] 0]]} {
		set text "![join [lrange [split $text] 1 end]]"
	}

	# обработка ответов
	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]]]} {
				# правильный ответ
				if {![playground check $chan hide-answers]} {
					set correct "\226 \"\2$text\2\" \226 "
				} else {
					set correct ""
				}

				# время, потребовавшееся на ответ
				set time [expr [clock seconds] - $game(asktime)]

				if {$hand == "*"} {
					putmsg $chan "\00310Молодец, $nick!  Правильный ответ ${correct}был дан за \00304$time\00310 [lindex {. секунду секунды секунд} [numgrp $time]], но не принёс тебе ни одного очка, т.к. для начала тебе нужно зарегистрироваться.\003"
					putmsg $nick "Для того, чтобы зарегистрироваться, достаточно сказать мне два слова: \002pass пароль\002 (пароль придумай).  Сделать это потребуется всего однажды, и нужно для того, чтоб никто не мог играть от твоего имени (а неверный ответ отнимает одно очко, знаешь?)."
					putmsg $nick "Пароль нужно запомнить, ник \226 тоже, чтобы когда у тебя сменится адрес (появится другой интернет-провайдер, например), не приходилось начинать игру сначала.  Если это \226 как раз твой случай, то ты можешь попробовать восстановиться, сказав мне: \002ident пароль\002"
					putmsg $nick "Дополнительная информация о командах, которые я понимаю, есть здесь: $conf(url-cmd)"
				} else {
					users check $hand

					array set usr [users get $hand]

					# подсчёт правильных ответов
					if {$game(lst_user) == $hand} {
						incr game(lst_cnt)
					} else {
						set game(lst_cnt) 1
						set game(lst_user) $hand
					}

					# Дополнительные очки за блиц
					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 отвечает на $game(lst_cnt) [lindex {. вопрос вопроса вопросов} [numgrp $game(lst_cnt)]] подряд!"
					}

					# проверка на самый быстрый ответ
					if {$time < $usr(quick) || $usr(quick) < 1} {
						set usr(quick) $time
						set msg_time ", и это твой самый быстрый ответ,"
					} else {
						set msg_time ""
					}

					# начисление очков
					incr usr(answers)
					incr usr(score) $game(points)

					# подсчёт общеигровой статистики
					incr game(cnt_won)

					putmsg $chan "\00310Молодец, $nick!  Правильный ответ ${correct}был дан за \00304$time\00310 [lindex {. секунду секунды секунд} [numgrp $time]]$msg_time и принёс тебе\00304 $game(points)\00310 [lindex {. очко очка очков} [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
			}
		}

		# ответ неопознан
		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]]

	# команды нет
	if {[info commands ::tpub::cmd_$cmd] == ""} { return }

	# коррекция имени пользователя (только для выдачи в лог)
	set user [expr {$hand == "*" ? "$nick!$uhost" : $hand}]

	# выполняем...
	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 "У тебя нет доступа к команде \002$cmd\002, ты уж извини..."
	}

	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 "Возможные команды ([llength $cmds]):$cmds.  Более детальная информация по каждой команде может быть получена по запросу в форме \002!help команда\002, а также по адресу $conf(url-cmd)"
}


### dump
proc ::tpub::cmd_dump {nick chan text} {
	if {$text == "" || "$chan $text" == "? ?"} { return [usage $nick dump text "посылает указанный текст непосредственно на сервер."] }
	if {[string first m [chattr [nick2hand $nick]]] == -1} { return deny }
	putserv $text
}


### сохранение информации о пользователях и чтение базы вопросов
proc ::tpub::cmd_rehash {nick chan text} {
	if {"$chan $text" == "? ?"} { return [usage $nick rehash "" "обновление конфигурации бота и самого скрипта. На ход игры никак не влияет."] }
	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
}


### переход на другой сервер
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]
}


### перезапуск бота
proc ::tpub::cmd_restart {nick chan text} {
	if {"$chan $text" == "? ?"} { return [usage $nick restart "" "полный перезапуск бота, с остановкой текущего раунда и сохранением результатов."] }
	if {[string first n [chattr [nick2hand $nick]]] == -1} { return deny }
	restart
}


### склеивание пользователей
proc ::tpub::cmd_append {nick chan text} {
	if {[llength $text] < 2} { return [usage $nick append "user_who user_to" "добавление данных об одном пользователе к другому, первый удаляется"] }

	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 "Пользователь $h1 мне неизвестен."
		return 0
	}

	if {$h1 == $h2} {
		putnot $nick "Невозможно соединить пользователя с самим собой."
		return 0
	}

	array set user1 [users get $h1]
	array set user2 [users get $h2]

	# очки
	catch { incr user2(score) $user1(score) }

	# ответы
	catch { incr user2(answers) $user1(answers) }

	# скорость ответа
	catch { if {$user1(quick) < $user2(quick) && $user1(quick)} { set user2(quick) $user1(quick) } }

	# ответы подряд..
	catch { if {$user1(cont) > $user2(cont)} { set user2(cont) $user1(cont) } }

	# мыло
	catch { if {$user2(email) == "" && $user1(email) != ""} { set user2(email) $user1(email) } }

	# мемо
	catch { if {$user2(memo) == "" && $user1(memo) != ""} { set user2(memo) $user1(memo) } }

	# время последнего появления
	catch { if {$user1(last) > $user2(last)} { set user2(last) $user1(last) } }

	users set [list $h1 {}]
	users set [list $h2 [array get user2]]

	putnot $nick "Информация о пользователе $h1 удалена, все его достижения добавлены к пользователю $h2."
}


### переименовка пользователя
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 "Пользователь $nick1 не обнаружен."
		return 0
	}

	if {[validuser $nick2] && [string compare -nocase $nick1 $nick2]} {
		putnot $nick "Пользователь $nick2 уже существует."
		return 0
	}

	chhandle $nick1 $nick2

	putnot $nick "Пользователь $nick1 успешно переименован в $nick2."
}


### получение опа
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 "" "выдача статуса оператора, при наличии соответствующего уровня доступа."] }

	if {![validchan $chan]} {
		putnot $nick "Команда !op может быть использована только на канале, контроллируемом мною."
		return
	}

	if {![isop $botnick $chan]} {
		putnot $nick "К сожалению, у меня нет опа на $chan, не могу ничем помочь.."
		return
	}

	if {[string first o [chattr [nick2hand $nick] $chan]] == -1} {
		return deny
	} else {
		pushmode $chan +o $nick
	}
}


### наведение порядка в канале
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 "ник ?причина...?" "выкинуть пользователя с канала, аргументировав это указанным комментарием (при отсутствии используется комментарий по умолчанию)"] }

	if {![validchan $chan]} {
		putnot $nick "Команда !kick может быть использована только на канале, контроллируемом мною."
		return
	}

	if {[string first o [chattr [nick2hand $nick] $chan]] == -1} { return deny }

	if {![isop $botnick $chan]} {
		putnot $nick "К сожалению, у меня нет опа на канале $chan, ничем не могу помочь."
		return
	}

	set victim [string trim [string range $text 0 [string first \040 $text]]]
	if {![string compare -nocase $victim $botnick]} {
		putact $chan "застрелился ;)"
		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 "и не таких распинали ($nick)"
	}

	putserv "KICK $chan $victim :$reason"
}


### смена топика
proc ::tpub::cmd_topic {nick chan text} {
	if {"$chan $text" == "? ?"} { return [usage $nick topic "?текст...?" "смена топика канала на указанный, или его снятие в случае неуказания."] }
	if {[string first o [chattr [nick2hand $nick]]] == -1} { return deny }
	putserv "TOPIC $chan :$text"
}


### вывод информации о боте
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 "3hauka.tcl, версия [getversion].  Подробная информация о скрипте доступна по адресу \037\00312http://quiz.forestnet.org/\003\037"
	} else {
		if {[info exists conf(url)]} {
			set homeinfo "  Подробная информация доступна по адресу $conf(url)"
		} else { set homeinfo "" }
		putact $chan "\226 это eggdrop v.[lindex $version 0] (tcl $tcl_patchLevel) + 3hauka.tcl версии [getversion].$homeinfo"
	}
}


### список пользователей
proc ::tpub::cmd_list {nick chan text} {
	if {"$chan $text" == "? ?"} { return [usage $nick list "" "получение полного списка пользователей, в порядке убывания очков."] }

	if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }

	if {![llength [set users [users list]]]} {
		putpvt $nick "инофрмация о пользователях отсутствует."
	} else {
		set lst "([llength $users])"
		foreach item $users { append lst " [lindex $item 0]" }

		putpvt $nick "$lst."
	}
}


### удаление информации о пользователе
proc ::tpub::cmd_забудь {nick chan text} { return [cmd_forget $nick $chan $text] }
proc ::tpub::cmd_forget {nick chan text} {
	if {$text == "" || "$chan $text" == "? ?"} { return [usage $nick forget "ник" "удаление данных об указанном пользователе."] }

	if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }

	if {![validuser $text]} {
		putnot $nick "никакой информации о пользователе $user нет."
		return 0
	}

	users set [list $text {}]

	putact $chan "забыл всё, что когда-либо знал о $user"
}


### информация о пользователе
proc ::tpub::cmd_raw {nick chan text} {
	if {$text == "" || "$chan $text" == "? ?"} { return [usage $nick raw "ник" "получение информации о пользователе в \"сыром\" виде"] }

	if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }

	if {![validuser $text]} {
		putnot $nick "Пользователь $text не зарегистрирован."
		return 0
	}

	if {[set xtra [users get $text]] == ""} {
		putnot $nick "Информация о пользователе $text отсутствует."
		return 0
	}

	putpvt $nick "raw($text): [join $xtra]"
}


### ручная коррекция
proc ::tpub::cmd_set {nick chan text} {
	if {[llength [split $text]] < 2} { return [usage $nick set "ник параметр ?значение?" "ручная установка значения параметров пользователям (список имеющихся параметров и ищ значений доступен по команде \002raw\002), при неуказанном значении параметр удаляется"] }

	if {[string first o [chattr [nick2hand $nick] [expr {[validchan $chan] ? $chan : ""}]]] == -1} { return deny }

	if {![validuser [set user [lindex [split $text] 0]]]} {
		putnot $nick "Пользователь \002$user\002 мне неизвестен."
		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 "Значение параметра $para для пользователя $user удалено."
	} else {
		set usr($para) $data
		putnot $nick "Значение параметра $para для пользователя $user изменено на: $data"
	}

	users set [list $user [array get usr]]
}


### установка примечания
proc ::tpub::cmd_memo {nick chan text} {
	if {$text == "" || "$chan $text" == "? ?"} { return [usage $nick memo "примечание" "установка указанного комментария к собственному нику, отображается по команде \002!вон\002, а так же на сайте канала, если таковой имеется. Для удаления комментария следует указать \"none\"."] }

	if {[set hand [nick2hand $nick]] == "*"} {
		putnot "Установка примечания возможно только для зарегистрированных пользователей (ответь как минимум на один вопрос)."
		return 0
	}

	array set user [users get $hand]

	if {$text == ""} {
		if {[info exists user(memo)]} {
			putnot $nick "Твоё примечание: $user(memo)"
		} else {
			putnot $nick "Примечание не установлено."
		}
		return 0
	} elseif {($text == "none") || ($text == "нет")} {
		if {[info exists user(memo)]} { unset user(memo) }
		putnot $nick "Примечание удалено."
	} else {
		set user(memo) [string range $text 0 199]
		putnot $nick "Твоё примечание изменено на: $user(memo)"
	}

	users set [list $hand [array get user]]
}


### установка и-мэйла
proc ::tpub::cmd_email {nick chan text} {
	if {$text == "" || "$chan $text" == "? ?"} { return [usage $nick email "адрес" "установка собственного e-mail адреса, для отображения, например, на сайте канала"] }

	if {[set hand [nick2hand $nick]] == "*" || ![validuser $hand]} {
		putnot $nick "Установка адреса электронной почты возможна только для зарегистрированных пользователей (например, ответивших хотя бы на один вопрос)."
		return 0
	}

	array set user [users get $hand]

	if {$text == ""} {
		if {![info exists user(email)]} {
			putnot $nick "Адрес электронной почты не установлен."
		} else {
			putnot $nick "Твой адрес электронной почты: $user(email)"
		}
		return 0
	} elseif {$text == "none" || $text == "нет"} {
		if {[info exists user(email)]} { unset user(email) }
		putnot $nick "Удалил информацию о твоей электронной почте."
	} else {
		set user(email) [lindex [split $text] 0]
		putnot $nick "Твой адрес электронной почты изменён на $user(email)"
	}

	users set [list $hand [array get user]]
}


### запуск викторины
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 "" "запуск викторины на текущем канале, если это разрешено хозяином бота."] }

	if {[lsearch -exact [channel info $chan] "+bitch"] != -1 && [nick2hand $nick] == "*"} {
		return
	}

	if {[info exists game]} {
		if {$game(chan) == $chan} {
			putnot $nick "викторина уже запущена :)"
		} else {
			putmsg $chan "$nick, викторина уже запущена на канале $game(chan), милости просим ;)"
		}
		return
	}

	if {![set ::tpub::qcount] && ![question rehash]} {
		putmsg $chan "$nick, к сожалению, в базе данных нет ни одного вопроса, запуск викторины невозможен..."
		return
	}

	if {![playground exists $chan]} {
		putmsg $chan "$nick, запуск викторины на этом канале невозможен."
		return
	}

	if {![checktime]} {
		putmsg $chan "$nick, запуск викторины на данный момент невозможен - время работы ограничено моим хозяином."
		return
	}

	if {[set hand [nick2hand $nick]] == "*"} {
		global botnick
		putnot $nick "Для участия в викторине нужно зарегистрироваться.  Сделать это можно командой \002/msg $botnick PASS пароль\002, после чего можно снова приниматься за игру."
		return
	}

	set modes {blitz блиц}

	if {$text != "" && [lsearch $modes $text] == -1} {
		putmsg $chan "$nick, не знаю такого режима игры \226 $text, знаю: [join $modes {, }]."
		return
	}

	if {[lsearch -exact {blitz блиц} [lindex [split $text] 0]] != -1} {
		set game(blitz) 1
		set what "блиц-турнир"
	} else {
		set what "игру"
	}

	putmsg $chan "\00310Добро пожаловать на нашу викторину!  Начинаем $what.  В базе данных [set ::tpub::qcount] [lindex {. вопрос вопроса вопросов} [numgrp [set ::tpub::qcount]]].\003"

	# проверка целостности информации о пользователе, добавление хоста
	users check [set hand [nick2hand $nick]]

	# инициализация
	set game(chan) $chan			;# канал
	set game(creator) $hand			;# юзер, запустивший игру (для !stop)
	set game(started) [clock seconds]	;# время начала игры
	set game(cnt_lost) 0			;# количество потерянных вопросов
	set game(cnt_won) 0			;# количество правильных ответов
	set game(qid) 0				;# номер текущего вопроса
	set game(lst_user) ""			;# последний правильно ответивший на вопрос
	set game(lst_cnt) 0			;# текущее количество правильных ответов подряд

	# задаём первый вопрос
	utimer 5 ::tpub::tmr_ask
}


### информация о текущем вопросе
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 "" "вывод текущего вопроса, если был задан."] }

	if {![info exists game]} {
		putmsg $chan "$nick, викторина не запущена - воспользуйся командой \002!start\002"
		return 0
	}

	if {![info exists game(question)]} {
		putnot $nick "вопрос ещё не был задан."
		return 0
	}

	putnot $nick "текущий вопрос: [lindex $game(question) 0]"
	return 0
}


### запрос подсказки
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 хинт "" "выдаёт подсказку по текущему вопросу, с задержкой в 5 секунд, последующие подсказки выдаются с задержкой в 20 секунд.  Вывод каждой подсказки отнимает одно очко от первоначальной стоимости вопроса (3 очка)."] }

	if {![info exists game] || $game(chan) != $chan || ![info exists game(question)]} {
		return 0
	}

	if {[info exists game(blitz)]} {
		return 0
	}

	# поиск уже активной подсказки
	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
}


### пропуск вопроса
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 "" "пропуск текущего вопроса. Команда доступна только операторам, пятёрке лучших игроков и пользователю, запустившему викторину."] }

	if {[string range $chan 0 0] != "#"} {
		putlog "3HAuKA: skip request from $nick ignored (not on channel)."
		return
	}

	# проверяем, запушена ли игра.
	if {![info exists game]} {
		putmsg $chan "$nick, викторина не запущена - воспользуйся командой \002!start\002"
		return
	}

	# нельзя
	if {[playground check $chan no-skip]} {
		putlog "3HAuKA: 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)
}


### остановка викторины
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 "" "остановка текущего раунда викторины. Доступно только операторам, пятёрке лучших игроков и пользователю, запустившему викторину."] }

	if {![info exists game]} {
		putmsg $chan "$nick, викторина не запущена - воспользуйся командой \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 "Викторина остановлена."

	if {$game(qid)} {
		append msg " Всего [lindex {. прозвучал прозвучало прозвучало} [numgrp $game(qid)]] $game(qid) [lindex {. вопрос вопроса вопросов} [numgrp $game(qid)]]"
		if {$game(cnt_won)} { append msg ", из которых на $game(cnt_won) был дан правильный ответ." } else { append msg "." }

		append msg " Игра длилась [game_time]."
	}

	putmsg $chan "\00304$msg\003"

	unset game
	users purge
}


### вывод лучших игроков
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 "?количество?" "вывод информации о лучших игроках."] }

	# во время игры
	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)] ? ". Более подробная статистика может быть получена по адресу \00312\037$conf(url-top)\037" : "."}]
		putmsg $chan "\0034Текущая пятёрка лидеров: [string range $msg 2 end]$url\003"
		return
	}

	if {![llength [set users [users list]]]} {
		putmsg $chan "$nick, таблица рекордов пуста."
		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 {Пятёрка Шестёрка Семёрка Восьмёрка Девятка Десятка} [expr $count - 5]] лучших на данный момент:\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Ну вот, собственно. А больше-то никто и не играл. ;)\003" : [expr {[info exists conf(url-top)] ? "\00304Более подробная информация может быть получена по адресу \00312\037$conf(url-top)\003" : "\00304Ну вот, собственно. А остальные внимания не заслуживают... ;)\003"}] }]
}


### вывод информации о пользователе
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 "?ник?" "вывод информации по указанному нику, или о текущем пользователе."] }

	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 "В базе данных всего [llength $list] пользовател[lindex {. ь я ей} [numgrp [llength $list]]]."
			return 0
		}

		set hand [lindex [lindex $list [expr int($text) - 1]] 0]
	}

	if {$hand == "" || $hand == "*"} {
		if {$text == ""} {
			putnot $nick "Никакой информации о тебе нет, поиграешь может? ;)"
		} else {
			putnot $nick "Пользователь $text мне неизвестен..."
		}
		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 "Никакой информации о пользователе $hand у меня нет."
		return 0
	}

	set msg "На счету $hand уже $user(answers) [lindex {. ответ ответа ответов} [numgrp $user(answers)]] ($user(score) [lindex {. очко очка очков} [numgrp $user(score)]])"

	if {$user(cont) > 1} {
		append msg ", лучший результат \226 $user(cont) [lindex {. ответ ответа ответов} [numgrp $user(cont)]] подряд"
	}

	append msg ", самый быстрый ответ был дан за $user(quick) [lindex {. секунду секунды секунд} [numgrp $user(quick)]]"

	if {[info exists user(memo)]} {
		append msg " (примечание: $user(memo))"
	}

	if {$place} {
		set honor [expr {$place < 6 ? " почётное" : ""}]
		append msg ". Занимает $hand$honor $place-е место"
	}

	putmsg $chan "\00302$msg.\003"
}


### статистика по игре
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 "" "вывод информации о текущей игре, и статистику по базе вопросов."] }

	set usercount [llength [users list]]

	set msg "База данных содержит [set ::tpub::qcount] [lindex {. вопрос вопроса вопросов} [numgrp [set ::tpub::qcount]]], из которых [set count [question count]] ещё не [lindex {. задан заданы заданы} [numgrp $count]]. Всего [lindex {. зарегистрирован зарегистрировано зарегистрировано} [numgrp $usercount]] $usercount [lindex {. пользователь пользователя пользователей} [numgrp $usercount]]"

	if {[info exists game]} {
		if {$chan != $game(chan)} {
			append msg ". На данный момент викторина запущена на канале $game(chan)"
		}
		append msg ". Всего [lindex {. прозвучал прозвучало прозвучало} [numgrp $game(qid)]] $game(qid) [lindex {. вопрос вопроса вопросов} [numgrp $game(qid)]], из которых на $game(cnt_won) был дан правильный ответ.  Игра длится [game_time]"

		if {[info exists game(creator)]} {
			append msg ", и была запущена по команде $game(creator)"
		}
	}

	putmsg $chan "\0034$msg.\003"
}


### раздача крестов входящим
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 "Текущий раунд длится [game_time]"
		if {[info exists game(question)]} {
			append not ", вопрос: \"[lindex $game(question) 0]\""
		} else { append not "." }
	}

	if {$not != ""} { putnot $nick $not }
}


### выдача очередного вопроса
### 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)]
}


### выдача следующего вопроса
proc ::tpub::tmr_next {qid} { variable game
	if {![info exists game] || ![info exists game(question)] || $qid != $game(qid)} { return }

	# сброс информации о количестве ответов "подряд"
	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) }

	# проверяем, не вышли ли мы за отведённые временные рамки
	set ct [checktime]

	# количество потеряных вопросов
	if {!$ct || [incr game(cnt_lost)] == 3} {
		if {$game(cnt_lost) == 3} {
			set msg "Игра остановлена в связи с отсутствием интереса к ней"
		} else {
			set msg "Игра остановлена в связи с установленными временными ограничениями"
		}

		if {$game(qid)} { append msg ". Всего [lindex {. прозвучал прозвучало прозвучало} [numgrp $game(qid)]] $game(qid) [lindex {. вопрос вопроса вопросов} [numgrp $game(qid)]], " }

		if {$game(cnt_won)} {
			append msg "из которых на $game(cnt_won) был дан правильный ответ."
		} else {
			append msg "правильных ответов получено не было."
		}

		putmsg $game(chan) "\00304$msg Игра длилась [game_time].\003"

		unset game
		return
	}

	putmsg $game(chan) "\00303Никто не ответил на вопрос, следующий через 5 секунд.\003"
	unset game(question)
	utimer 5 ::tpub::tmr_ask
}


### выдача подсказок
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]]
}


### начальная инициализация
namespace eval tpub {
	if {![set count [question count]]} { set count [question rehash] }
	putlog "3HAuKA-[getversion] here, $qcount [lindex {. question questions questions} [numgrp $qcount]], $count cached left."
}


# подсказка
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]]"
}


# информация о пользователе
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
}


# юзерлист
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
		}
	}
}


# периодическое сохранение результатов
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
