Скрипт анекдотов с anekdot.ru

Решение вопросов при работе с TCL скриптами.

Модератор: Модераторы

Скрипт анекдотов с anekdot.ru

Сообщение tvrsh » 04 дек 2008 01:20

Написал скриптик который забирает анекдоты с сайта anekdot.ru
TCL: [ Скачать ] [ Скрыть ]
namespace eval anekdot {}
setudef flag nopubanekdot
set anekdot(pref) "!"
set anekdot(commands) "анекдот анек anekdot anek"
set anekdot(time) 10
set anekdot(page) http://pda.anekdot.ru/
set anekdot(version) "1.0"
set anekdot(author) "tvrsh @ IrcNet.ru"
package require http
foreach bind [split $anekdot(commands) " "] {
        bind pub -|- $anekdot(pref)$bind ::anekdot::pub
        bind msg -|- $anekdot(pref)$bind ::anekdot::msg
}

proc ::anekdot::msg {nick uhost hand arg} {
    ::anekdot::anekdot $nick $uhost $hand $nick $arg
}

proc ::anekdot::pub {nick uhost hand chan arg} {
   if {[channel get $chan nopubanekdot]} return
   ::anekdot::anekdot $nick $uhost $hand $chan $arg
}

proc ::anekdot::anekdot {nick uhost hand chan arg} {
        global anekdot lastbind
       set arg [lindex [split $arg] 0]
        if {[info exists anekdot(host,$uhost)]} {
                if {$chan == $nick} {
                        putquick "PRIVMSG $nick :\00303Пожалуйста подождите. Запрос не чаще одного раза в \00304$anekdot(time) \00303секунд."
                        return
                } else {
                        putquick "NOTICE $nick :\00303Пожалуйста подождите. Запрос не чаще одного раза в \00304$anekdot(time) \00303секунд."
                        return
                }
        }
       
       set agent "Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.1) Gecko/2008070208 Firefox/3.0.1"
        set anekdot(host,$uhost) 1
        set anekdot(timer,$uhost) [utimer $anekdot(time) [list ::anekdot::reset $uhost ] ]
        set anekdot_tok [::http::config -useragent $agent]
        set anekdot_tok [::http::geturl $anekdot(page) -timeout 30000]  
        set html [::http::data $anekdot_tok]
        ::http::cleanup $anekdot_tok

       set asplitr [lindex {¤ • # * + °} [rand 6]]
       set acolor [lindex {\00309 \00308 \00307 \00304 \00311 \00315 \00310} [rand 7]]

       regexp {<a href="/anekdots/random">.*?</a></h2><p>(.*?)</p>} $html "" data

       if {[info exists ::sp_version]} {
           set data [encoding convertfrom cp1251 $data]
       } else {
           set data [encoding convertto utf-8 [encoding convertfrom cp1251 $data]]
       }

       regsub -all -- {<br />} $data "|" data
       foreach line [split $data "|"] {
           putserv "PRIVMSG $chan :$line"
       }
       putserv "PRIVMSG $chan :[colorize $asplitr$asplitr$asplitr]"
       return 0
}

proc ::anekdot::reset { uhost } {
        global anekdot
        catch {killutimer $cod(timer,$uhost)}
        catch {unset anekdot(timer,$uhost)}
        catch {unset anekdot(host,$uhost)}
}

proc colorize {text} {
foreach bukva [split $text ""] {
set cccolor [lindex "01 02 03 04 05 06 07 08 09 10 11 12 13 14 15" [rand 15]]
set bukva "\003$cccolor$bukva"
lappend text2 $bukva
}
return [join $text2 ""]
}

putlog "anekdot.ru.tcl v$anekdot(version) by $anekdot(author) loaded."


Все очень просто. В выводе используется процедура раскраски текста выложенная чуть раньше на этом форуме.
Have fun.
-
Получить помощь можно на каналах #egghelp в сети IrcNet.ru и #eggdrop в сети RusNet(Ключ канала eggdrop).
Перед созданием новой темы внимательно читайте Правила оформления топиков.
Аватара пользователя
tvrsh
 
Сообщения: 1230
Зарегистрирован: 19 авг 2008 16:55
Откуда: Russian Federation, Podolsk
Благодарил (а): 6 раз.
Поблагодарили: 130 раз.
Версия бота: Eggdrop 1.6.20+suzi

Re: Скрипт анекдотов с anekdot.ru

Сообщение teomen » 12 дек 2008 06:23

классный скрипт. сделать бы ещё что бы он сам по автомату кидал бы анекдоты по времени
teomen
 
Сообщения: 1
Зарегистрирован: 12 дек 2008 06:20
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.

Re: Скрипт анекдотов с anekdot.ru

Сообщение tvrsh » 14 дек 2008 17:23

Скрипт пишет анекдот в канал раз в 5 минут.
Чтобы изменить интервал времени смотри мануалы по bind time в папке doc твоего бота. Или в этом файле http://www.egghelp.ru/file.php?id=52
TCL: [ Скачать ] [ Скрыть ]
namespace eval anekdot {}
setudef flag nopubanekdot
set anekdot(channel) #erotic
set anekdot(page) http://pda.anekdot.ru/
set anekdot(version) "1.0"
set anekdot(author) "tvrsh @ IrcNet.ru"
package require http

bind time - "?5 * * * *" ::anekdot::anekdot
bind time - "?0 * * * *" ::anekdot::anekdot

proc ::anekdot::anekdot {min hour day month year} {
        global anekdot lastbind
        set agent "Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.1) Gecko/2008070208 Firefox/3.0.1"
        set anekdot_tok [::http::config -useragent $agent]
        set anekdot_tok [::http::geturl $anekdot(page) -timeout 30000]  
        set html [::http::data $anekdot_tok]
        ::http::cleanup $anekdot_tok

       set asplitr [lindex {¤ • # * + °} [rand 6]]

       set rgx "Случайный\\\ анекдот(.*?)еще\\\ анекдоты"
       regsub -all -- {\n} $html "" html
           foreach line [split $html \n] {
               if {[regexp -nocase -- $rgx $line garb data]} {
               regsub -all -- {<a.*?>} $data "" data
               regsub -all -- {<p.*?>} $data "" data
               regsub -all -- {<div.*?>} $data "" data
               regsub -all -- {</h1>} $data "" data
               regsub -all -- {</p>} $data "" data
               regsub -all -- {</div>} $data "" data
               regsub -all -- {<br />} $data "|" data
                   foreach line [split $data "|"] {
                       putserv "PRIVMSG $anekdot(channel) :$line"
                   }
               putserv "PRIVMSG $anekdot(channel) :$asplitr$asplitr$asplitr"
               return
                }      
        }

}

putlog "anekdot.ru.tcl v$anekdot(version) by $anekdot(author) loaded."
Have fun.
-
Получить помощь можно на каналах #egghelp в сети IrcNet.ru и #eggdrop в сети RusNet(Ключ канала eggdrop).
Перед созданием новой темы внимательно читайте Правила оформления топиков.
Аватара пользователя
tvrsh
 
Сообщения: 1230
Зарегистрирован: 19 авг 2008 16:55
Откуда: Russian Federation, Podolsk
Благодарил (а): 6 раз.
Поблагодарили: 130 раз.
Версия бота: Eggdrop 1.6.20+suzi

Re: Скрипт анекдотов с anekdot.ru

Сообщение dinger » 04 июл 2010 22:21

Есть работающий скрипт?
dinger
 
Сообщения: 2
Зарегистрирован: 02 июл 2010 16:11
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Версия бота: Eggdrop 1.6.19+suzi

Re: Скрипт анекдотов с anekdot.ru

Сообщение tvrsh » 05 июл 2010 00:58

dinger писал(а):Есть работающий скрипт?

Есть, в первом и третьем посте в этой теме.
Have fun.
-
Получить помощь можно на каналах #egghelp в сети IrcNet.ru и #eggdrop в сети RusNet(Ключ канала eggdrop).
Перед созданием новой темы внимательно читайте Правила оформления топиков.
Аватара пользователя
tvrsh
 
Сообщения: 1230
Зарегистрирован: 19 авг 2008 16:55
Откуда: Russian Federation, Podolsk
Благодарил (а): 6 раз.
Поблагодарили: 130 раз.
Версия бота: Eggdrop 1.6.20+suzi

Re: Скрипт анекдотов с anekdot.ru

Сообщение antoma » 11 авг 2010 01:00

первый рабочий, третий нет, вывод в канал отсутствует
antoma
 
Сообщения: 1
Зарегистрирован: 11 авг 2010 00:06
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.

Re: Скрипт анекдотов с anekdot.ru

Сообщение tvrsh » 12 авг 2010 00:33

antoma писал(а):первый рабочий, третий нет, вывод в канал отсутствует

Вывод в канал присутствует
                       putserv "PRIVMSG $anekdot(channel) :$line"

Раз ты на столько умен, может почитаешь Правила оформления топиков., особенно 2-й пункт в них.
Have fun.
-
Получить помощь можно на каналах #egghelp в сети IrcNet.ru и #eggdrop в сети RusNet(Ключ канала eggdrop).
Перед созданием новой темы внимательно читайте Правила оформления топиков.
Аватара пользователя
tvrsh
 
Сообщения: 1230
Зарегистрирован: 19 авг 2008 16:55
Откуда: Russian Federation, Podolsk
Благодарил (а): 6 раз.
Поблагодарили: 130 раз.
Версия бота: Eggdrop 1.6.20+suzi

Re: Скрипт анекдотов с anekdot.ru

Сообщение tvrsh » 14 окт 2011 18:59

Обновил скрипт. Работает для сузи ботов теперь.
Have fun.
-
Получить помощь можно на каналах #egghelp в сети IrcNet.ru и #eggdrop в сети RusNet(Ключ канала eggdrop).
Перед созданием новой темы внимательно читайте Правила оформления топиков.
Аватара пользователя
tvrsh
 
Сообщения: 1230
Зарегистрирован: 19 авг 2008 16:55
Откуда: Russian Federation, Podolsk
Благодарил (а): 6 раз.
Поблагодарили: 130 раз.
Версия бота: Eggdrop 1.6.20+suzi


Вернуться в TCL скрипты

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 9

cron