### # # Название: allmusic.tcl # Версия: 1.4 # Автор: tvrsh # Оффсайт: http://egghelp.ru/ # ### # # Описание: Скрипт забирает с сайта http://allmusic.com/ информацию о музыкальных коллективах. # ### # # Установка: # 1. Скопируйте скрипт allmusic.tcl в папку scripts вашего бота. # 2. В файле eggdrop.conf впишите строку source scripts/allmusic.tcl # 3. Сделайте .rehash боту. # ### # # Версион хистори: # # 1.0(08.07.2011) Первая паблик версия. # 1.1(15.07.2012) Скрипт обновлен из-за изменений на сайте. # 1.2(20.10.2012) Скрипт обновлен из-за изменений на сайте. # 1.3(19.12.2012) Скрипт обновлен из-за изменений на сайте. # 1.4(16.08.2013) Скрипт обновлен из-за изменений на сайте. # ### namespace eval allmusic { # Сбрасываем значения всех переменных. foreach p [array names allmusic *] { catch {unset allmusic($p)} } # Указываем канальный флаг(.chanset #chan +allmusic для включения скрипта). setudef flag allmusic ### ### # Меню настроек ниже этой линии: # # ______________________________ # ### ### variable allmusic array set allmusic { pref {!} binds {allmusic allm amus} searchres 3 biolength 500 msg 1 delay 10 color1 \00314 color2 \00303 color3 \00305 version "allmusic.tcl version 1.4" author "tvrsh" } ### ### # Ниже этой линии начинается код, не изменяйте его если не знаете TCL: # # ____________________________________________________________________ # ### ### package require http 2.7 # Обработка биндов. foreach bind [split $allmusic(binds) " "] { bind pub -|- "$allmusic(pref)$bind" ::allmusic::allmusic_pub if {$allmusic(msg) >= 1} { bind msg -|- "$allmusic(pref)$bind" ::allmusic::allmusic_msg } } # Процедура обработки приватных команд. proc ::allmusic::allmusic_msg {nick uhost hand text} { variable allmusic ::allmusic::allmusic_proc $nick $uhost $hand $nick $text } # Процедура обработки паблик команд. proc ::allmusic::allmusic_pub {nick uhost hand chan text} { variable allmusic # Проверяем наличие флага. if {![channel get $chan allmusic]} { return 0 } ::allmusic::allmusic_proc $nick $uhost $hand $chan $text } # Процедура обработки запроса. proc ::allmusic::allmusic_proc {nick uhost hand chan text} { global lastbind variable allmusic if {$text == ""} { putserv "PRIVMSG $chan :$allmusic(color1)Используйте $allmusic(color2)$lastbind $allmusic(color3)<название коллектива> $allmusic(color1)для поиска и получаения информации о нем.\003" return 0 } if {[info exists allmusic(lasttime,$chan)] && [expr $allmusic(lasttime,$chan) + $allmusic(delay)] > [clock seconds]} { putserv "NOTICE $nick :$allmusic(color1)Запрос не чаще одного раза в $allmusic(color2)$allmusic(delay) $allmusic(color1)[lindex {. секунду секунды секунд} [::allmusic::allmusic_numgrp $allmusic(delay)]]." putserv "NOTICE $nick :$allmusic(color1)Подождите $allmusic(color3)[expr $allmusic(delay) - [expr [clock seconds] - $allmusic(lasttime,$chan)]] $allmusic(color1)[lindex {. секунду секунды секунд} [::allmusic::allmusic_numgrp [expr $allmusic(delay) - [expr [clock seconds] - $allmusic(lasttime,$chan)]]]] до следующего запроса." return 0 } regsub -all -- { } $text "+" text ::http::config -urlencoding "utf-8" -useragent "Mozilla/4.0 (compatible; MSIE 4.01; Windows CE; PPC; 240x320)" set allmusic_tok [::http::geturl "http://www.allmusic.com/search/artists/[::http::formatQuery $text]/" -timeout "15000"] set data [::http::data $allmusic_tok] putlog "\[allmusic\] $nick/$chan/$text" upvar #0 $allmusic_tok state foreach {name value} $state(meta) { if {[regexp -nocase ^location$ $name]} { putlog $value ::allmusic::allmusic_parce $nick $uhost $hand $chan $value return 0 } } ::http::cleanup $allmusic_tok regsub -all -- {\n} $data "" data regsub -all -- {^.*?
(.*?)} $data "" biography
regsub -all -- {} $biography "$allmusic(color3)" biography
regsub -all -- {} $biography "$allmusic(color1)" biography
regsub -all -- {]*\>} $biography "" biography
if {$biography != ""} {
::allmusic::largetext PRIVMSG $chan "$allmusic(color3)\002Biography\002: $allmusic(color1)[string trim [string range $biography 0 $allmusic(biolength)]]\003"
}
set members ""
regexp {Group Members
(.*?)} $data "" members
regsub -all -- {} $members " $allmusic(color1)/$allmusic(color2)" members
regsub -all -- {\<[^\>]*\>} $members "" members
regsub -all -- {\s+} $members " " members
if {$members != ""} {
putserv "PRIVMSG $chan :$allmusic(color1)\002Members\002: $allmusic(color2)[string trim $members " $allmusic(color1)/$allmusic(color2)"].\003"
}
set similar ""
regexp {Related Artists
(.*?)} $data "" similar
regsub -all -- {} $similar " $allmusic(color1)/$allmusic(color2)" similar
regsub -all -- {\<[^\>]*\>} $similar "" similar
regsub -all -- {\s+} $similar " " similar
if {$similar != ""} {
putserv "PRIVMSG $chan :$allmusic(color1)\002Similar Artists\002: $allmusic(color2)[string trim $similar " $allmusic(color1)/$allmusic(color2)"].\003"
}
return 0
}
proc ::allmusic::largetext {type target text {delims {" "•,.!?}}} {
set lineLen [expr 512 - [string length ":$::botname $type [join $target] :\r\n"]]
if {[string length $text] <= $lineLen} {
putserv "$type $target :$text"
return 0
}
set _text [split $text $delims]
set x 0
set i 0
while {$x < $lineLen} {
if {$i >= [llength $_text]} {
return 0
}
set wordlen [string length [lindex $_text $i]]
if {$x + $wordlen > $lineLen} {
break
}
incr x $wordlen
incr x
incr i
}
putserv "$type $target :[string range $text 0 [expr $x - 1]]"
set color [string range [lindex [split [string range $text 0 [expr $x - 1]] "\003"] [expr [llength [split [string range $text 0 [expr $x - 1]] "\003"]] - 1]] 0 1]
if {![isnumber $color]} {set color ""}
::allmusic::largetext $type $target \003$color[string trimleft [string range $text $x end]] $delims
}
proc ::allmusic::allmusic_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}
}
}
# Выводим сообщение о том, что скрипт удачно загружен.
putlog "\[allmusic\] $allmusic(version) by $allmusic(author) loaded"
}