Code: Select all
#######################################################################
# #
# rssnews.tcl - RSS news announcer for eggdrop by demond@demond.net #
# #
# this will announce the updated news from RSS feed(s), #
# periodically polling the feed(s); supports multiple #
# channels, one feed per channel; you only need to set #
# the feeds array, see below #
# #
# Usage: !rss <news#|*> (read news# or * for headlines list) #
# #
#######################################################################
package require Tcl 8.3
package require eggdrop 1.6
package require http 2.0
namespace eval rssnews {
# set your feed(s) sources here: channel, poll frequency in mins, feed URL
#
#set feeds(#katrina-news) {3 http://www.chron.com/rss/special/05/katrina/index.rss}
#set feeds(#katrina-news) {3 http://rss.nola.com/nola_localbreakingnews/index.rss}
variable version "rssnews-1.0"
variable timeout 20 ;# seconds
bind pub - !rss [namespace current]::news
bind time - * [namespace current]::timer
putlog "$version by demond loaded"
proc timer {min hour day month year} {
variable feeds
if {[info exists feeds]} {
if {$min} {set min [string trimleft $min 0]}
foreach {chan feed} [array get feeds] {
if {$min && $min % [lindex $feed 0] == 0} {
fetch [lindex $feed 1] $chan
}
}}
}
proc fetch {url chan} {
variable timeout
variable version; variable token
set to [expr {$timeout * 1000}]
set cmd [namespace current]::callback
::http::config -useragent "$version by demond"
if {[catch {set t [::http::geturl $url -command $cmd -timeout $to]} err]} {
putlog "$version: ERROR($chan): $err"
} {
set token($t) $chan
}
}
proc callback {t} {
variable version; variable token
set chan $token($t)
switch -exact [::http::status $t] {
"timeout" {
putlog "$version: ERROR($chan): timeout"
}
"error" {
putlog "$version: ERROR($chan): [::http::error $t]"
}
"ok" {
if {[::http::ncode $t] != 200} {
putlog "$version: ERROR($chan): [::http::code $t]"
} {
process [::http::data $t] $chan
}
}
default {
putlog "$version: ERROR($chan): got EOF from socket"
}}
::http::cleanup $t
}
proc process {data chan} {
variable news; variable hash
set idx 1; set news($chan) {}
regsub -all {(?i)<items.*?>.*?</items>} $data {} data
foreach {foo item} [regexp -all -inline {(?i)<item.*?>(.*?)</item>} $data] {
regexp {(?i)<title>(.*?)</title>} $item -> title
regexp {(?i)<link>(.*?)</link} $item -> link
regexp {(?i)<description>(.*?)</description>} $item -> descr
strip title descr
if {[info exists hash($chan)]} {
if {[lsearch -exact $hash($chan) [md5 $title]] == -1} {
if {[botonchan $chan]} {
puthelp "privmsg $chan :($idx) $title"
}
}}
lappend news($chan) [list $title $link $descr]
lappend hashes [md5 $title]
incr idx
}
set hash($chan) $hashes
}
proc strip {args} {
variable html
foreach a $args {
upvar $a x
set amp {& &}
set x [string map $amp $x]
set x [string map $html $x]
regsub -all {<[^<]+?>} $x {} x
}
}
proc news {nick uhost hand chan text} {
variable news; variable feeds
set num [lindex [split $text] 0]
if {$num == ""} {
puthelp "notice $nick :Usage: $::lastbind <news#|*>"
return
}
if {$num != "*" && ![string is integer $num]} {
puthelp "notice $nick :argument must be number or *"
return
}
if {![info exists news($chan)]} {
puthelp "notice $nick :no news for this channel"
return
}
if {$num == "*"} {
set idx 1
puthelp "notice $nick :News source: [lindex $feeds($chan) 1]"
foreach item $news($chan) {
puthelp "notice $nick :($idx) [lindex $item 0]"
incr idx
}
return 1
} {
if {$num < 1 || $num > [llength $news($chan)]} {
puthelp "notice $nick :no such news index, try $::lastbind *"
} {
set idx [expr {$num-1}]
puthelp "notice $nick :......title($num): [lindex [lindex $news($chan) $idx] 0]"
puthelp "notice $nick :description($num): [lindex [lindex $news($chan) $idx] 2]"
puthelp "notice $nick :.......link($num): [lindex [lindex $news($chan) $idx] 1]"
return 1
}}
}
variable html {
" \x22 ' \x27 & \x26 < \x3C
> \x3E \x20 ¡ \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 ' \x27 <p> \x20 <br> \x20 \n \x20
}
}
Code: Select all
#######################################################################
# #
# rssnews.tcl - RSS news announcer for eggdrop by demond@demond.net #
# #
# this will announce the updated news from RSS feed(s), #
# periodically polling the feed(s); supports multiple #
# channels, one feed per channel; you only need to set #
# the feeds array, see below #
# #
# Usage: !rss <news#|*> (read news# or * for headlines list) #
# #
#######################################################################
package require Tcl 8.3
package require eggdrop 1.6
package require http 2.0
namespace eval rssnews {
# set your feed(s) sources here: channel, poll frequency in mins, feed URL
set feeds(#chan1) {3 http://www.chron.com/rss/special/05/katrina/index.rss}
set feeds(#chan2) {3 http://rss.nola.com/nola_localbreakingnews/index.rss}
# maximum number of announced new headlines
#
variable maxnew 5
# feed fetch timeout in seconds
#
variable timeout 20
# nothing to edit below
variable version "rssnews-1.2"
bind pub - !rss [namespace current]::news
bind time - * [namespace current]::timer
putlog "$version by demond loaded"
proc timer {min hour day month year} {
variable feeds
if {[info exists feeds]} {
if {$min} {set min [string trimleft $min 0]}
foreach {chan feed} [array get feeds] {
if {$min && $min % [lindex $feed 0] == 0} {
fetch [lindex $feed 1] $chan
}
}}
}
proc fetch {url chan} {
variable timeout
variable version; variable token
set to [expr {$timeout * 1000}]
set cmd [namespace current]::callback
::http::config -useragent "$version by demond"
if {[catch {set t [::http::geturl $url -command $cmd -timeout $to]} err]} {
putlog "$version: ERROR($chan): $err"
} {
set token($t) $chan
}
}
proc callback {t} {
variable version; variable token
set chan $token($t)
switch -exact [::http::status $t] {
"timeout" {
putlog "$version: ERROR($chan): timeout"
}
"error" {
putlog "$version: ERROR($chan): [::http::error $t]"
}
"ok" {
if {[::http::ncode $t] != 200} {
putlog "$version: ERROR($chan): [::http::code $t]"
} {
process [::http::data $t] $chan
}
}
default {
putlog "$version: ERROR($chan): got EOF from socket"
}}
::http::cleanup $t
}
proc process {data chan} {
variable news; variable hash
variable maxnew; variable source
set idx 1; set count 0
set news($chan) {}; set source($chan) ""
if {[regexp {(?i)<title>(.*?)</title>} $data -> foo]} {
append source($chan) $foo
}
if {[regexp {(?i)<description>(.*?)</description>} $data -> foo]} {
append source($chan) " | $foo"
}
regsub -all {(?i)<items.*?>.*?</items>} $data {} data
foreach {foo item} [regexp -all -inline {(?i)<item.*?>(.*?)</item>} $data] {
regexp {(?i)<title>(.*?)</title>} $item -> title
regexp {(?i)<link>(.*?)</link} $item -> link
regexp {(?i)<description>(.*?)</description>} $item -> descr
if {![info exists title]} {set title "(none)"}
if {![info exists link]} {set link "(none)"}
if {![info exists descr]} {set descr "(none)"}
strip title link descr
if {[info exists hash($chan)]} {
if {[lsearch -exact $hash($chan) [md5 $title]] == -1 && [botonchan $chan]} {
if {$count < $maxnew} {
puthelp "privmsg $chan :($idx) $title"
incr count
} {
lappend indices $idx
}
}}
lappend news($chan) [list $title $link $descr]
lappend hashes [md5 $title]
incr idx
}
if {[info exists indices] && [botonchan $chan]} {
set count [llength $indices]
set indices "(indices: [join $indices {, }])"
puthelp "privmsg $chan :...and $count more $indices"
}
set hash($chan) $hashes
}
proc strip {args} {
variable html
foreach a $args {
upvar $a x
set amp {& &}
set x [string map $amp $x]
set x [string map $html $x]
while {[regexp -indices {(&#[0-9]{1,3};)} $x -> idxs]} {
set b [lindex $idxs 0]; set e [lindex $idxs 1]
set num [string range $x [expr {$b+2}] [expr {$e-1}]]
if {$num < 256} {
set x [string replace $x $b $e [format %c $num]]
}
}
regexp {(?i)<!\[CDATA\[(.*?)\]\]>} $x -> x
regsub -all {(?i)</t[dr]><t[dr].*?>} $x { | } x
regsub -all {(?i)(<p>|<br>|\n)} $x { } x
regsub -all {<[^<]+?>} $x {} x
}
}
proc news {nick uhost hand chan text} {
variable source
variable news; variable feeds
set num [lindex [split $text] 0]
if {$num == ""} {
puthelp "notice $nick :Usage: $::lastbind <news#|*>"
return
}
if {$num != "*" && ![string is integer $num]} {
puthelp "notice $nick :argument must be number or *"
return
}
if {![info exists news($chan)]} {
puthelp "notice $nick :no news for this channel"
return
}
if {$num == "*"} {
set idx 1
if {$source($chan) != ""} {
set title $source($chan)
} {
set title [lindex $feeds($chan) 1]
}
puthelp "notice $nick :News source: \002$title\002"
foreach item $news($chan) {
puthelp "notice $nick :($idx) [lindex $item 0]"
incr idx
}
return 1
} {
if {$num < 1 || $num > [llength $news($chan)]} {
puthelp "notice $nick :no such news index, try $::lastbind *"
} {
set idx [expr {$num-1}]
puthelp "notice $nick :......title($num): [lindex [lindex $news($chan) $idx] 0]"
puthelp "notice $nick :description($num): [lindex [lindex $news($chan) $idx] 2]"
puthelp "notice $nick :.......link($num): [lindex [lindex $news($chan) $idx] 1]"
return 1
}}
}
variable html {
" \x22 ' \x27 & \x26 < \x3C
> \x3E \x20 ¡ \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
}
}
Code: Select all
<(Bot> [14:35] rssnews-1.2: ERROR(#trivia): timeout
Code: Select all
[11:33] rssnews 1.2 by demond loaded
[11:33] Userfile loaded, unpacking...
USERFILE ALREADY EXISTS <drop the -m>