I use this version of the perplexa's script :
Code: Select all
## $Id: rssnews.tcl,v 4.5.0251 2005/01/04 9:12PM perpleXa Exp $
## -------------------------------------------------------------
## ___ ___ ___
## /\ \ /\ \ /\ \
## /::\ \ /::\ \ /::\ \
## /:/\:\ \ /:/\ \ \ /:/\ \ \
## /::\~\:\ \ _\:\~\ \ \ _\:\~\ \ \
## /:/\:\ \:\__\ /\ \:\ \ \__\ /\ \:\ \ \__\
## \/_|::\/:/ / \:\ \:\ \/__/ \:\ \:\ \/__/
## |:|::/ / \:\ \:\__\ \:\ \:\__\
## |:|\/__/ \:\/:/ / \:\/:/ /
## |:| | \::/ / \::/ /
## \|__| \/__/ \/__/ feed parser
##
## http://perpleXa.net | http://dev.perpleXa.net
## #perpleXa on QuakeNet
## (C) 2004
##
## This script is approved to parse all valid RSS feeds.
## If You discover any issues regarding installing or running
## this script so feel free to contact me on QuakeNet.
##
## Enjoy.
##
##
## FAQ:
##
## Q. What are these weird characters in the layout?
## A. You can use <upfirstchar text>, <id>, <publisher>, <news>, <link>,
## as well as control codes, to change the design to something you'd like
## Available colors and control codes are:
## \002 bold
## \003 [00-15] colors
## \017 reset control codes
## \026 reverse
## \037 underline
##
## Q. How do I control this script?
## A. There isn't much to say, just type $news <feed> in a channel or /msg <bot> news <feed>
## All the other stuff works automatically. ie. When you set your feed like "set feed(ESReality) { ... }"
## you have to type $news ESReality or /msg <bot> news ESReality to receive news from that feed.
##
## Q. How do I setup my own feeds?
## A. Look at the examples below, you should find all neccessary information in the first one.
##
## Q. Where can I find more feeds?
## A. Try out http://www.feedroom.com and http://www.syndic8.com/
##
## Q. I've discovered a bug, what should I do?
## A. Write an email, use the contact field on my website or contact me on #perpleXa (QuakeNet)
##
## -------------------------------------------------------------
## Don't touch this line!
array unset feed
##
## -------------------------------------------------------------
## ---- Setup --------------------------------------------------
set feed(3DGamers) {
URL=http://www.3dgamers.com:80/feeds/netscape/3dgamers.rss /* The location of the news, in format http://domain.com:port/file.xml (port value is optional). */
DATABASE=scripts/dbase/rssnews/.3dgamers /* The file where the news are saved. */
CHANNELS=#resistless #Nitro-Clan /* On which channels is the feed activated? Set to ALL for all channels. */
POSTNEWS=1 /* Post news if there are new ones? */
POSTLIMIT=3 /* max. posted news */
PUBLIMIT=3 /* How many news are posted on pub triggers? */
MSGLIMIT=10 /* How many news are posted on msg triggers? */
/* Thats the design used for automated output. */
POSTLAYOUT=\00300,14\[\00309\002!\002\00300\] \00300www.\002\003093D\00300gamers\002.com \[\00309\002!\002\00300\] <news> \[\00309\002!\002\00300\] <link> \[\00309\002!\002\00300\]\003
/* And this one is for use on trigger events. */
TRIGLAYOUT=\00300,14\[\00309\002!\002\00300\] \00300www.\002\003093D\00300gamers\002.com \[\00309\002!\002\00300\] <news> \[\00309\002!\002\00300\] <link> \[\00309\002!\002\00300\]\003
}
## ---- End of Setup -------------------------------------------
## -------------------------------------------------------------
if {[package vcompare [info tclversion] 8.4] < 0} {
putlog "You don't have TCL 8.4, you have to upgrade to version 8.4 or higher to use [file tail [info script]]."
return;
}
package require http
namespace eval rss {
variable protect 60
variable timeout 20
variable pubbind {$news}
variable msgbind {news}
variable v_major 4
variable v_minor 5
variable v_build 0251
variable version $v_major.$v_minor.$v_build
variable client "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7) Gecko/20040803 Firefox/0.9.3"
bind PUB -|- $pubbind [namespace current]::public
bind MSG -|- $msgbind [namespace current]::private
bind TIME -|- {?0 * * * *} [namespace current]::check
namespace export public private check
}
proc rss::check {args} {
global feed
variable client
variable timeout
putquick "PING :[clock seconds]" -next
foreach id [array names feed] {
set url "0"
set database "0"
set channels "0"
set postnews "1"
set postlimit "3"
set publimit "3"
set msglimit "10"
set postlayout {\00314(\00307<publisher>\00314)\00307 <news> \00314<\00307<link>\00314>\003}
foreach line [split $feed($id) \n] {
regsub -all -- {/\*.*?\*/} $line {} line
regexp -nocase -- {^\s*URL=(.+?)\s*$} $line tmp url
regexp -nocase -- {^\s*DATABASE=(.+?)\s*$} $line tmp database
regexp -nocase -- {^\s*CHANNELS=(.+?)\s*$} $line tmp channels
regexp -nocase -- {^\s*POSTNEWS=(.+?)\s*$} $line tmp postnews
regexp -nocase -- {^\s*POSTLIMIT=(.+?)\s*$} $line tmp postlimit
regexp -nocase -- {^\s*PUBLIMIT=(.+?)\s*$} $line tmp publimit
regexp -nocase -- {^\s*MSGLIMIT=(.+?)\s*$} $line tmp msglimit
regexp -nocase -- {^\s*POSTLAYOUT=(.+?)\s*$} $line tmp postlayout
}
if {($url == 0) || ($database == 0) || ($channels == 0)} {
putlog "RSS: Warning: Couldn't load configuration for the \[$id\] feed."
continue
}
if {$postnews == 0} {
continue
}
if {![file isdirectory [file dirname $database]]} {
file mkdir [file dirname $database]
}
set count 0
set data {}
http::config -useragent $client
catch {http::geturl $url -command "[namespace current]::check:data {$database} {$channels} {$postlimit} {$postlayout}" -timeout [expr $timeout * 1000]}
}
}
proc rss::check:data {database channels postlimit postlayout token} {
upvar 0 $token state
if {![string equal -nocase $state(status) "ok"]} {
return 0
}
set latestnews "iddqd"
if {[file exists $database]} {
set temp [open $database r+]
set latestnews [gets $temp]
if {[string length $latestnews] <= 1} {
set latestnews "iddqd"
}
close $temp
}
set data [http::data $token]
http::cleanup $token
set publisher [publisher $data]
set data [parse $data]
set temp [open $database w+]
set postlayout [join $postlayout { }]
foreach {item} $data {
regsub -all -- {<id>} $postlayout [lindex $item 0] output
regsub -all -- {<publisher>} $output $publisher output
regsub -all -- {<link>} $output [lindex $item 1] output
regsub -all -- {<news>} $output [lindex $item 2] output
regsub -all -- {<upfirstchar\s(.*?)>} [clean $output] {[upfirstchar "\1"]} output
puts $temp [decode [subst $output]]
}
close $temp
set count 0
set temp [open $database r+]
while {![eof $temp]} {
gets $temp headline
if {([string equal -nocase $latestnews $headline]) || ([string equal -nocase $latestnews "iddqd"]) || ($count == $postlimit)} {
break
}
incr count
msg $channels $headline
}
close $temp
}
proc rss::news {target id type} {
global feed
variable client
variable timeout
if {$type == 2} {
set msgtype PRIVMSG
} else {
set msgtype NOTICE
}
set url "0"
set publimit "3"
set msglimit "10"
set triglayout "\00314\[\00307<id>\00314\]\00307 <news> \00314<\00307<link>\00314>\003"
foreach item [split $feed($id) \n] {
regsub -all -- {/\*.*?\*/} $item {} item
regexp -nocase -- {^\s*URL=(.+?)\s*$} $item tmp url
regexp -nocase -- {^\s*PUBLIMIT=(.+?)\s*$} $item tmp publimit
regexp -nocase -- {^\s*MSGLIMIT=(.+?)\s*$} $item tmp msglimit
regexp -nocase -- {^\s*TRIGLAYOUT=(.+?)\s*$} $item tmp triglayout
}
if {($url == 0)} {
putquick "$msgtype $target :Warning: Couldn't load configuration for the \[$id\] feed."
return 0
}
if {$type == 1} {
set limit $msglimit
} elseif {$type == 2} {
set limit $publimit
} else {
return 0
}
http::config -useragent $client
catch {http::geturl $url -timeout [expr $timeout * 1000]} token
if {[regexp -nocase -- {^couldn\'t\sopen\ssocket:\s+?(.*)$} $token tmp state(status)]} {
putquick "$msgtype $target :Warning: Couldn't connect to the \[$id\] feed ($state(status))."
return 0
}
upvar 0 $token state
if {![string equal -nocase $state(status) "ok"]} {
putquick "$msgtype $target :Warning: Couldn't connect to the \[$id\] feed (connection $state(status))."
return 0
}
set data [http::data $token]
http::cleanup $token
set publisher [publisher $data]
set data [parse $data]
set count 0
set triglayout [join $triglayout { }]
foreach {item} $data {
incr count
regsub -all -- {<id>} $triglayout [lindex $item 0] output
regsub -all -- {<publisher>} $output $publisher output
regsub -all -- {<link>} $output [lindex $item 1] output
regsub -all -- {<news>} $output [lindex $item 2] output
regsub -all -- {<upfirstchar\s(.*?)>} [clean $output] {[upfirstchar "\1"]} output
set output [decode [subst $output]]
if {$type == 2} {
if {[regexp -- {c} [getchanmode $target]]} {
set output [stripcodes c $output]
}
}
puthelp "$msgtype $target :$output"
if {($count == $limit)} {
break
}
}
}
proc rss::publisher {content} {
set publisher {n/a}
regsub -all -- {\n+|\s+|\t+} $content { } content
regsub -all -- {([\\&])} $content {\\\1} content
regexp -nocase -- {<title>(.+?)</title>} $content tmp publisher
return $publisher
}
proc rss::parse {content} {
regsub -all -- {\n+|\s+|\t+} $content { } content
regsub -all -- {([\\&])} $content {\\\1} content
set item 0
set news ""
while {[regexp -nocase -- {<item(\s[^>]*?)?>(.+?)</item>} $content -> & value]} {
incr item
set title {n/a}
regexp -nocase -- {<title>(.+?)</title>} $value -> title
regexp -nocase -- {\<\!\[CDATA\[(.*?)\]\]\>} $title -> title
set link {n/a}
regexp -nocase -- {<link>(.+?)</link>} $value -> link
regexp -nocase -- {\<\!\[CDATA\[(.*?)\]\]\>} $link -> link
regsub -nocase -- {<item.*?>.+?</item>} $content {} content
lappend news "$item {$link} {$title}"
}
return [lsort -integer -unique -index 0 $news]
}
proc rss::decode {content} {
if {![regexp -- & $content]} {
return $content
}
set escapes {
\x20 " \x22 & \x26 ' \x27 – \x2D < \x3C > \x3E ˜ \x7E € \x80 ¡ \xA1
¢ \xA2 £ \xA3 ¤ \xA4 ¥ \xA5 ¦ \xA6 § \xA7 ¨ \xA8 © \xA9 ª \xAA « \xAB
¬ \xAC \xAD ® \xAE &hibar; \xAF ° \xB0 ± \xB1 ² \xB2 ³ \xB3 ´ \xB4 µ \xB5
¶ \xB6 · \xB7 ¸ \xB8 ¹ \xB9 º \xBA » \xBB ¼ \xBC ½ \xBD ¾ \xBE ¿ \xBF
À \xC0 Á \xC1 Â \xC2 Ã \xC3 Ä \xC4 Å \xC5 Æ \xC6 Ç \xC7 È \xC8 É \xC9
Ê \xCA Ë \xCB Ì \xCC Í \xCD Î \xCE Ï \xCF Ð \xD0 Ñ \xD1 Ò \xD2 Ó \xD3
Ô \xD4 Õ \xD5 Ö \xD6 × \xD7 Ø \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 ÷ \xF7 ø \xF8 ù \xF9 ú \xFA û \xFB
ü \xFC ý \xFD þ \xFE ÿ \xFF
}
set content [string map $escapes $content]
regsub -all -- {&[a-zA-Z]+?;} [clean $content] {?} content
regsub -all -- {&#(\d{1,3});} $content {[format %c [scan \1 %d]]} content
return [subst $content]
}
proc rss::private {nickname hostname handle arguments} {
global feed
variable spam
variable protect
set arguments [clean $arguments]
set spewfeed [lindex $arguments 0]
if {![validfeed $spewfeed 1]} {
putquick "NOTICE $nickname :Please supply a valid feed: [join [lsort -dictionary [array names feed]] ",\x20"]"
return 0
}
set spewfeed [validfeed $spewfeed 2]
if {([info exists spam(flood,$spewfeed,$hostname)])} {
set s [expr [clock seconds] - $spam(flood,$spewfeed,$hostname)]
if {$s < $protect} {
putquick "NOTICE $nickname :Sorry - This trigger has recently been used. It will be unlocked in [expr $protect - $s] seconds."
return 0
}
}
set spam(flood,$spewfeed,$hostname) [clock seconds]
news $nickname $spewfeed 1
}
proc rss::public {nickname hostname handle channel arguments} {
global feed
variable spam
variable protect
set arguments [clean $arguments]
set spewfeed [lindex $arguments 0]
if {![validfeed $spewfeed 1]} {
putquick "PRIVMSG $channel :Please supply a valid feed: [join [lsort -dictionary -unique [array names feed]] ",\x20"]"
return 0
}
set spewfeed [validfeed $spewfeed 2]
if {([info exists spam(flood,$spewfeed,$channel)]) && (![isop $nickname $channel])} {
set s [expr [clock seconds] - $spam(flood,$spewfeed,$channel)]
if {$s < $protect} {
putquick "PRIVMSG $channel :Sorry - This trigger has recently been used. It will be unlocked in [expr $protect - $s] seconds."
return 0
}
}
set spam(flood,$spewfeed,$channel) [clock seconds]
set channels 0
foreach item [split $feed($spewfeed) \n] {
regsub -all -- {/\*.*\*/} $item {} item
regexp -nocase -- {^\s*CHANNELS=(.+?)\s*$} $item tmp channels
}
if {([lsearch -exact [string tolower $channels] [string tolower $channel]] == -1) && (![string equal -nocase $channels "ALL"])} {
putquick "PRIVMSG $channel :The \[$spewfeed\] feed is not available on this channel. ($channels)"
return 0
}
news $channel $spewfeed 2
}
proc rss::msg {channels headline} {
if {[string equal -nocase $channels "ALL"]} {
foreach channel [channels] {
if {[regexp -- {c} [getchanmode $channel]] && [regexp -- {\003} $headline]} {
lappend nocolors $channel
} else {
lappend colors $channel
}
}
} else {
foreach channel [channels] {
if {[lsearch -exact [string tolower $channels] [string tolower $channel]] >= 0} {
if {[regexp -- {c} [getchanmode $channel]] && [regexp -- {\003} $headline]} {
lappend nocolors $channel
} else {
lappend colors $channel
}
}
}
}
if {[info exists nocolors]} {
putquick "PRIVMSG [join $nocolors {,}] :[stripcodes c $headline]"
}
if {[info exists colors]} {
putquick "PRIVMSG [join $colors {,}] :$headline"
}
}
proc rss::validfeed {keyword type} {
global feed
foreach id [array names feed] {
if {[string equal -nocase $id $keyword]} {
switch -exact -- $type {
{1} {
return 1
}
{2} {
return $id
}
}
}
}
return 0
}
proc rss::upfirstchar {content} {
regsub -all -- {((^|\s)([a-z]))} [clean $content] {[string toupper "\1"]} content
return [subst $content]
}
proc rss::clean {string} {
regsub -all -- {([\(\)\[\]\{\}\$\"\\])} $string {\\\1} string
return $string
}
putlog "Script loaded: RSS feed parser $rss::version (C) 2004 perpleXa."
please Help me !!!
thx
