## bash.tcl v0.8.1 by Vertigo@RusNet
## Скрипт показа цитат с http://bash.im (ex. http://bash.org.ru)
## !bash - случайная
## !bash <номер> - вывод с указанным номером
## !bash <текст> - поиск
## !bash [-номер] -cache [номер цитаты на сайте] - вывод из кэша.
## Если указан "номер цитаты на сайте", будет производиться поиск в кэше цитаты с указанным номером. Пример: !bash -cache 408599
## Вывод из кэша также будет, если есть проблемы с соединением.
## Включить на канале: .chanset #chan +bash
## Включить вывод по времени: настроить время вывода (ниже) и включить вывод на нужных каналах (.chanset #chan +autobash)
package require http 2.7
package require Tcl 8.5
namespace eval ::bash {
foreach bind [binds [namespace current]::*] {
catch {unbind [lindex $bind 0] [lindex $bind 1] [lindex $bind 2] [lindex $bind 4]}
}
##
# Настройки
##
# префикс команд
set prefix "!"
# через сколько минут выводить цитаты в автоматическом режиме [1-59]
variable timer "36"
# какого цвета выводить саму цитату 00-15
variable color "03"
# биндим команды
bind pub - ${prefix}баш ::bash::pub
bind pub - ${prefix}bash ::bash::pub
bind msg - ${prefix}баш ::bash::msg
bind msg - ${prefix}bash ::bash::msg
bind time - "* * * * *" ::bash::time
# путь к файлу кэша
variable cache {data/bash.tmp}
# какое маскимальное кол-во линий выводить в паблик (не учитывается при выводе по таймеру)
variable maxquotes 10
# задержка на вызов команды (сек)
set ::bash::check(delay) "20"
# таймаут соединения с сервером (сек)
variable timeout "10"
##
# Конец настроек
##
variable version "0.8.1"
variable need_load 0
variable search 0
setudef flag bash
setudef flag autobash
proc pub {nick uhost hand chan text} {
if {![channel get $chan bash]} {return}
main $nick $uhost $hand $chan $text
}
proc msg {nick uhost hand text} {
main $nick $uhost $hand $nick $text
}
proc main {nick uhost hand chan text} {
variable cache
variable need_load
variable search
variable timeout
set search 0
set need_load 1
if {[info exists ::bash::check(lasttime,$uhost)] && [expr $::bash::check(lasttime,$uhost) + $::bash::check(delay)] > [clock seconds] && ![matchattr $hand n]} {
putserv "NOTICE $nick :Команда $::lastbind станет для Вас доступна через [::bash::duration [expr $::bash::check(delay) - [expr [clock seconds] - $::bash::check(lasttime,$uhost)]]]."
return
}
if {![file exists $cache]} {set file [open $cache w+]; close $file}
set file [open $cache r]
set lines [lrange [split [read $file] \n] 0 end-1]
close $file
if {![llength $lines]} {putlog "::bash:: cache is empty, refilling..."; set need_load 0}
unset -nocomplain lines
set index ""
if {[regexp -- {^-(\d+)} $text -> index_]} {set index [scan $index_ %d]; regsub -- "-$index" $text "" text}
regsub -all -- "\x20\x20" $text "\x20" text
set text [string trim $text]
set quote [lindex [split $text]]
if {$text eq "-cacheinfo"} {
set file [open $cache r]
set line [lrange [split [read $file] \n] 0 end-1]; close $file
putserv "PRIVMSG $chan :$nick: \00314Всего в кэше\00304 [llength $line]\00314 цитат, кэш занимает на диске\00304 [format "%.2f" [expr [file size $cache] /1024.0 /1024.0]] \00314Мбайт. Последняя цитата записана [duration [expr [clock seconds] -[file mtime $cache]]] назад."
unset -nocomplain line file
return
}
if {[regexp -- {^-cache} $text]} {
cache_get $nick $uhost $hand $chan $index $text
set ::bash::check(lasttime,$uhost) [clock seconds]
return
}
::http::config -urlencoding cp1251 -useragent "Opera/9.52 (Windows NT 5.1; ru)"
if {[string is digit $quote]} {set url "http://bash.im/quote/$quote"; set text $quote} else {
set url "http://bash.im/?text=[::http::formatQuery $text]"; set search 1}
if {$text eq ""} {set url "http://bash.im/random"}
set extra [list $nick $uhost $hand $chan $index $text]
#putlog "::bash::debug: url: $url :: extra: $extra"
set tok [::http::geturl $url -timeout [expr $timeout*1000] -command [list [namespace current]::data $extra]]
set ::bash::check(lasttime,$uhost) [clock seconds]
return
}
proc data { extra tok } {
variable cache
variable search
variable maxquotes
variable need_load
variable color
foreach {nick uhost hand chan index text} $extra {break}
set status [::http::status $tok]
set ncode [::http::ncode $tok]
if {$status ne "ok"} {
if {$status eq "error" && $need_load eq 0} {putserv "PRIVMSG $chan :$nick, error while processing your request, try again later. Sorry."; ::http::cleanup $tok; return 0}
if {$status eq "timeout" && $need_load eq 0} {putserv "PRIVMSG $chan :$nick, connect timeout, while processing your request, try again later. Sorry."; ::http::cleanup $tok; return 0}
}
if {$need_load eq 1 && $status ne "ok"} {
cache_get $nick $uhost $hand $chan $index $text
return
}
set html [::http::data $tok]
::http::cleanup $tok
if {[string match -nocase "*Цитат*не найдено*" $html] && $text != "*"} {putserv "PRIVMSG $chan :$nick, по вашему запросу ничего не найдено."; unset -nocomplain html; return}
set regexp {
.*">.*.*(.+?)(.+?)
(.+?)}
regsub -all -- "\n|\r|\t" $html "" html
set html [string map {\x5C "!@!"} $html]
set html [string map -nocase [list "" "\n
" "
" "\n
"] $html]
set list [list]
foreach line [split $html \n] {
if {![regexp -nocase -- {
(.+?)
} $line -> num rating date content] && \
![regexp -nocase -- {
(.+?)
} $line -> num rating date content] && ![regexp -nocase -- {} $line - num rating date content] \
} {continue}
# автоматом переделываем логи аськи (c) ck.lib
regsub -all -nocase {(((
)|^)\s*[^\s<]+\s+\([^\)]+\))
([^<]+)} $content {\1 \4} content
# если только 1 слово в строке - джойнить, например если только 'ник:' в строке
regsub -all -nocase {(((
)|^)\s*[^\s<]+\s*)
([^<]+)} $content {\1 \4} content
# логи с 'ник :' в одной строке
regsub -all -nocase {(((
)|^)\s*[^\s<]+\s+:\s*)
([^<]+)} $content {\1 \4} content
lappend list [list $num $rating [string map {{/} ""} $date] [string map {"!@!" "\x5C\x5C"} $content]]
}
if {$list eq {}} {
if {[string is digit $text]} {
putserv "PRIVMSG $chan :$nick, цитата #$text не найдена."
} else {
putserv "PRIVMSG $chan :$nick, parsing error!"
}
return 0
}
foreach _ $list {
lassign $_ num_ rating_ date_ content_
if {$rating_ eq "???"} {set rating_ "<не указан>"}
if {[string match "*\\.\\.\\.*" $rating_]} {set rating_ "<отстой>"}
set content_ [regsub -all -- {\s*\n*\s*\n+\s*} [webstrip [string map {"" "" {>} "\>" {<} "\<" {"} "\"" \x5c\x5c \x5c "
" \n "
" \n} $content_]] "\n"]
putcache [list $num_ $date_ [string map {\n \x1F} $content_] $rating_]
}
set total [llength $list]
if {$index eq ""} {set index "1"}
if {$index > "50"} {set index "50"}
set quote [lindex $list [expr $index-1]]
set num [lindex $quote 0]
set rating [lindex $quote 1]
if {$rating eq "???"} {set rating "<не указан>"}
if {[string match "*\\.\\.\\.*" $rating]} {set rating "<отстой>"}
set date [lindex $quote 2]
set content [lindex $quote 3]
set content [regsub -all -- {\s*\n*\s*\n+\s*} [webstrip [string map {"
" "" {>} "\>" {<} "\<" {"} "\"" \x5c\x5c \x5c "
" \n "
" \n} $content]] "\n"]
set mode ""
if {$search eq 1} {set mode "\00304\(\00303search\00304\)\003 :: "}
set lines [llength [split $content \n]]
if {$lines >= $maxquotes} {
putserv "PRIVMSG $chan :$nick, \00310Цитата \00304$num\00310 слишком большая \00314\[\00304$lines\00310 строк\00314\]\00310. Она будет отправлена тебе в приват."
if {$total >1} {set sch "\00314\[\00310$index\00314/\00311$total\00314\] "} else {set sch ""}
putserv "PRIVMSG $nick :$mode$sch\00312\037Цитата\037: \00305\#$num\017 :: \00310$date\017"
foreach _ [split $content \n] {
if {$_ ne ""} {putserv "PRIVMSG $nick :\003$color$_"}
}
putserv "PRIVMSG $nick :\00312\037Рейтинг\037: \00304$rating\017"
} else {
if {$total >1} {set sch "\00314\[\00310$index\00314/\00311$total\00314\] "} else {set sch ""}
putserv "PRIVMSG $chan :$mode$sch\00312\037Цитата\037: \00305\#$num\017 :: \00310$date\017"
foreach _ [split $content \n] {
if {$_ ne ""} {putserv "PRIVMSG $chan :\003$color$_"}
}
putserv "PRIVMSG $chan :\00312\037Рейтинг\037: \00304$rating\017"
}
unset -nocomplain list
}
proc putcache {data} {
variable cache
#putlog ".----::bash::putcache debug:----"
#putlog "|-> Quote #[lindex $data 0] :: Date: [lindex $data 1] :: Rating: [lindex $data 3]"
#foreach _ [split [lindex $data 2] \x1F] {putlog "|-> Body: $_"}
#putlog "`----::bash::putcache debug----"
set f [open $cache r]
set cdata [lrange [split [read $f] \n] 0 end-1]
close $f
if {![llength $cdata] || [lsearch -index 0 $cdata [lindex $data 0]] == "-1"} {
putlog "::bash::putcache debug: \002adding new quote #[lindex $data 0]"
set f [open $cache a]
puts $f $data
flush $f
close $f
unset -nocomplain data cdata f
return
}
putlog "::bash::putcache debug: \002\00304quote #[lindex $data 0] already exists in cache"
}
proc cache_get {nick uhost hand chan index text} {
variable cache
variable search
variable maxquotes
variable need_load
variable color
set text [string map {"-cache " ""} $text]
set f [open $cache r]
set list [lrange [split [read $f] \n] 0 end-1]
close $f
set total [llength $list]
if {$total eq 0} {putserv "PRIVMSG $nick :Cache empty."; return}
if {$index eq ""} {set index [rand $total]}
if {$index > $total} {set index $total}
if {[string is digit $text]} {
if {[set idx [lsearch -index 0 $list $text]] == "-1"} {
putserv "PRIVMSG $chan :$nick, такая цитата не найдена в кэше."
unset -nocomplain list
return
} else {
set quote [lindex $list $idx]
}
} else {
set quote [lindex $list $index]
}
lassign $quote num date content rating
set lines [llength [split $content \x1F]]
if {$lines >= $maxquotes} {
putserv "PRIVMSG $chan :$nick, \00310Цитата \00304$num\00310 слишком большая \00314\[\00304$lines\00310 строк\00314\]\00310. Она будет отправлена тебе в приват."
if {$total >1} {set sch "\00314\[\00310$index\00314/\00311$total\00314\] "} else {set sch ""}
putserv "PRIVMSG $nick :\00304(\00303cache\00304)\003 :: $sch\00312\037Цитата\037: \00305\#$num\017 :: \00310$date\017"
foreach _ [split $content \x1F] {
if {$_ ne ""} {putserv "PRIVMSG $chan :\003$color$_"}
}
putserv "PRIVMSG $nick :\00312\037Рейтинг\037: \00304$rating\017"
} else {
if {$total >1} {set sch "\00314\[\00310$index\00314/\00311$total\00314\] "} else {set sch ""}
putserv "PRIVMSG $chan :\00304(\00303cache\00304)\003 :: $sch\00312\037Цитата\037: \00305\#$num\017 :: \00310$date\017"
foreach _ [split $content \x1F] {
if {$_ ne ""} {putserv "PRIVMSG $chan :\003$color$_"}
}
putserv "PRIVMSG $chan :\00312\037Рейтинг\037: \00304$rating\017"
}
unset -nocomplain list quote
return
}
proc time {mins hours days weeks years} {
variable cache
variable timer
variable color
if {[expr [scan $mins %d]%$timer] != 0} {return}
set file [open $cache r]
set list [lrange [split [read $file] \n] 0 end-1]
close $file
set total [llength $list]
set chan ""
foreach _ [channels] {
if {[channel get $_ autobash]} {append chan $_,}
}
if {$chan eq ""} {
#putlog "::bash:: Error: No channels for auto-pasting!"
unset -nocomplain list file
return
}
set chan [string range $chan 0 end-1]
if {$total eq 0} {putserv "PRIVMSG $chan :Cache empty."; return}
set index [rand $total]
set quote [lindex $list $index]
lassign $quote num date content rating
if {$total >1} {set sch "\00314\[\00310$index\00314/\00311$total\00314\] "} else {set sch ""}
putserv "PRIVMSG $chan :\00304(\00303auto\00304)\003 :: $sch\00312\037Цитата\037: \00305\#$num\017 :: \00310$date\017"
foreach _ [split $content \x1F] {
if {$_ ne ""} {putserv "PRIVMSG $chan :\003$color$_"}
}
putserv "PRIVMSG $chan :\00312\037Рейтинг\037: \00304$rating\017"
unset -nocomplain list file
return
}
proc regsub-eval {re string cmd} {
return [subst [regsub -all $re [string map {\[ \\[ \] \\] \$ \\$ \\ \\\\} $string] "\[format %c \[$cmd\]\]"]]
}
proc webstrip {t} {
set t [string map -nocase {{—} {-} {»} {»} {«} {«} {"} {"} \
{<} {<} {>} {>} { } { } {&} {&} {©} {©} {©} {©} {•} {•} {·} {-} {§} {§} {®} {®} \
‖ || \
& & [ ( \ / ] ) { ( } ) \
£ Ј ¨ Ё © © « « ® ® \
¡ Ў ¿ ї ´ ґ · · ¹ № » » \
¼ ј ½ Ѕ ¾ ѕ À А Á Б Â В \
Ã Г Ä Д Å Е Æ Ж Ç З È И \
É Й Ê К Ë Л Ì М Í Н Î О \
Ï П Ð Р Ñ С Ò Т Ó У Ô Ф \
Õ Х Ö Ц × Ч Ø Ш Ù Щ Ú Ъ \
Û Ы Ü Ь Ý Э Þ Ю ß Я à а \
á б â в ã г ä д å е æ ж \
ç з è и é й ê к ë л ì м \
í н î о ï п ð р ñ с ò т \
ó у ô ф õ х ö ц ÷ ч ø ш \
ù щ ú ъ û ы ü ь ý э þ ю \
° ° ‧ · ˌ . ū u ī i ˈ ' \
ɔ o ɪ i ' ' } $t]
set t [string map -nocase {¡ \xA1 ¤ \xA4 ¢ \xA2 £ \xA3 ¥ \xA5 ¦ \xA6 \
§ \xA7 ¨ \xA8 © \xA9 ª \xAA « \xAB ¬ \xAC \
\xAD ® \xAE ¯ \xAF ° \xB0 ± \xB1 ² \xB2 \
³ \xB3 ´ \xB4 µ \xB5 ¶ \xB6 · \xB7 ¸ \xB8 \
¹ \xB9 º \xBA » \xBB ¼ \xBC ½ \xBD ¾ \xBE \
¿ \xBF × \xD7 ÷ \xF7 À \xC0 Á \xC1 Â \xC2 \
à \xC3 Ä \xC4 Å \xC5 Æ \xC6 Ç \xC7 È \xC8 \
É \xC9 Ê \xCA Ë \xCB Ì \xCC Í \xCD Î \xCE \
Ï \xCF Ð \xD0 Ñ \xD1 Ò \xD2 Ó \xD3 Ô \xD4 \
Õ \xD5 Ö \xD6 Ø \xD8 Ù \xD9 Ú \xDA Û \xDB \
Ü \xDC Ý \xDD Þ \xDE ß \xDF à \xE0 á \xE1 \
â \xE2 ã \xE3 ä \xE4 å \xE5 æ \xE6 ç \xE7 \
è \xE8 é \xE9 ê \xEA ë \xEB ì \xEC í \xED \
î \xEE ï \xEF ð \xF0 ñ \xF1 ò \xF2 ó \xF3 \
ô \xF4 õ \xF5 ö \xF6 ø \xF8 ù \xF9 ú \xFA \
û \xFB ü \xFC ý \xFD þ \xFE ÿ \xFF} $t]
set t [regsub-eval {([0-9]{1,5});} $t {string trimleft \1 "0"}]
regsub -all {[\x20\x09]+} $t " " t
#set t [string trim $t]
return [regsub -all -- {<.*?>} $t ""]
}
proc duration {seconds} {
set years [expr {$seconds / 31449600}]
set seconds [expr {$seconds % 31449600}]
set weeks [expr {$seconds / 604800}]
set seconds [expr {$seconds % 604800}]
set days [expr {$seconds / 86400}]
set seconds [expr {$seconds % 86400}]
set hours [expr {$seconds / 3600}]
set seconds [expr {$seconds % 3600}]
set minutes [expr {$seconds / 60}]
set seconds [expr {$seconds % 60}]
set res ""
if {$years != 0} {lappend res [numgrp $years "лет" "год" "года"]}
if {$weeks != 0} {lappend res [numgrp $weeks "недель" "неделю" "недели"]}
if {$days != 0} {lappend res [numgrp $days "дней" "день" "дня"]}
if {$hours != 0} {lappend res [numgrp $hours "часов" "час" "часа"]}
if {$minutes != 0} {lappend res [numgrp $minutes "минут" "минуту" "минуты"]}
if {$seconds != 0} {lappend res [numgrp $seconds "секунд" "секунду" "секунды"]}
return [join $res ", "]
}
proc numgrp {val str1 str2 str3} {
global dv
set d1 [expr $val % 10]
set d2 [expr $val % 100]
if {$d2 < 10 || $d2 > 19} {
if {$d1 == 1} {return "$val $str2"}
if {$d1 >= 2 && $d1 <= 4} {return "$val $str3"}
}
return "$val $str1"
}
putlog "bash.tcl v$version by Vertigo@RusNet loaded."
}