15/10/2008, 06:58
jai une erreur qui est la suite :
Tcl error [::rssnews::timer]: can't use non-numeric string as operand of "%"
le tcl n 'est pas de moi je vous met donc la source ci dessous
Tcl error [::rssnews::timer]: can't use non-numeric string as operand of "%"
le tcl n 'est pas de moi je vous met donc la source ci dessous
TCL
#######################################################################
# #
# 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/multiple feeds per channel; you only need to #
# set up your feeds array, see below; secure (SSL) and #
# private (password-protected) feeds are also supported #
# #
# Usage: !news <feed name> [news index #] - from channel #
# .rss <add|del|list> [name:#chan] - from partyline #
# #
#######################################################################
package require Tcl 8.3
package require eggdrop 1.6
package require http 2.0
namespace eval rssnews {
# set your feed(s) sources here: feed name, channel, poll frequency in mins, feed URL
#
#set feeds(osnews:#chan1) {17 http://www.osnews.com/files/recent.rdf}
#set feeds(google:#chan2) {11 http://news.google.com/news?ned=us&topic=h&output=rss}
#
# if you have to use password-protected feed, set it up like this:
#
#set feeds(name3:#chan3) {13 http://some.site.com/feed username password}
# maximum number of announced new headlines
#
variable maxnew 5
# feed fetch timeout in seconds
#
variable timeout 20
# public trigger flood settings
#
variable pubflud 5:15
# support SSL feeds (requires TLS package)
#
variable usessl 0
# if usessl is 1, request/require valid certificate from server
#
variable reqcert yes:no
#######################################################################
# nothing to edit below
variable version "rssnews-2.2"
if {$usessl} {
package require tls 1.5
scan $reqcert {%[^:]:%s} r1 r2
if {$r1 == "yes"} {set r1 1} {set r1 0}
if {$r2 == "yes"} {set r2 1} {set r2 0}
set ssl [list ::tls::socket -request $r1 -require $r2]
::http::register https 443 $ssl
}
bind dcc m rss [namespace current]::rss
bind pub - !news [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]} {
set mins [expr [scan $min %d]+[scan $hour %d]*60]
foreach {chanfeed settings} [array get feeds] {
if {$mins % [lindex $settings 0] == 0} {
if {[llength $settings] > 2} {
foreach {t url user pass} $settings {break}
fetch $url $chanfeed $user $pass
} {
foreach {t url} $settings {break}
fetch $url $chanfeed
}
}
}}
}
proc fetch {url chanfeed args} {
variable timeout
variable version; variable token
set to [expr {$timeout * 1000}]
set cmd [namespace current]::callback
if {[llength $args] > 0} {
foreach {user pass} $args {break}
set hdr [list Authorization "Basic [b64en $user:$pass]"]
} { set hdr {}}
::http::config -useragent "$version by demond"
if {[catch {set t [::http::geturl $url -command $cmd -timeout $to -headers $hdr]} err]} {
putlog "$version: ERROR($chanfeed): $err"
} {
set token($t) [list $url $chanfeed $args]
}
}
proc callback {t} {
variable version; variable token
foreach {url chanfeed args} $token($t) {break}
switch -exact [::http::status $t] {
"timeout" {
putlog "$version: ERROR($chanfeed): timeout"
}
"error" {
putlog "$version: ERROR($chanfeed): [::http::error $t]"
}
"ok" {
switch -glob [::http::ncode $t] {
3* {
upvar #0 $t state
array set meta $state(meta)
fetch $meta(Location) $chanfeed $args
}
200 {
process [::http::data $t] $chanfeed
}
default {
putlog "$version: ERROR($chanfeed): [::http::code $t]"
}}
}
default {
putlog "$version: ERROR($chanfeed): got EOF from socket"
}}
::http::cleanup $t
}
proc process {data chanfeed} {
variable news; variable hash
variable maxnew; variable source
set idx 1; set count 0
scan $chanfeed {%[^:]:%s} feed chan
set news($chanfeed) {}; set source($chanfeed) ""
if {[regexp {(?i)<title>(.*?)</title>} $data -> foo]} {
append source($chanfeed) $foo
}
if {[regexp {(?i)<description>(.*?)</description>} $data -> foo]} {
append source($chanfeed) " | $foo"
}
set infoline $source($chanfeed)
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)<desc.*?>(.*?)</desc.*?>} $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($chanfeed)]} {
if {[lsearch -exact $hash($chanfeed) [md5 $title]] == -1 && [botonchan $chan]} {
if {![info exists header]} {
if {$infoline == ""} {set header $feed} {set header $infoline}
puthelp "privmsg $chan :\002Breaking news\002 from $header!"
}
if {$count < $maxnew} {
puthelp "privmsg $chan :($idx) $title"
incr count
} {
lappend indices $idx
}
}}
lappend news($chanfeed) [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($chanfeed) $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 rss {hand idx text} {
variable feeds
if {$text == ""} {
putdcc $idx "Usage: .$::lastbind <add|del|list> \[name:#chan \[feed\]\]"
return
}
set text [split $text]
switch [lindex $text 0] {
"list" {
if {[info exists feeds]} {
foreach {chanfeed settings} [array get feeds] {
putdcc $idx "$chanfeed -> [join $settings]"
}}
}
"add" {
if {[llength $text] < 4} {
putdcc $idx "not enough add arguments"
return
}
set chanfeed [lindex $text 1]
if {[info exists feeds]} {
set names [string tolower [array names feeds]]
if {[lsearch -exact $names [string tolower $chanfeed]] != -1} {
putdcc $idx "$chanfeed already exists"
return
}}
set feeds($chanfeed) [lrange $text 2 end]
}
"del" {
set chanfeed [lindex $text 1]
if {[info exists feeds]} {
set names [string tolower [array names feeds]]
if {[lsearch -exact $names [string tolower $chanfeed]] == -1} {
putdcc $idx "$chanfeed does not exist"
return
} {
unset feeds($chanfeed)
}}
}
default {
putdcc $idx "invalid sub-command"
return
}
}
return 1
}
proc news {nick uhost hand chan text} {
variable source
variable news; variable feeds
variable pcount; variable pubflud
if {[info exists pcount]} {
set n [lindex $pcount 1]; incr n
set ts [lindex $pcount 0]
set pcount [list $ts $n]
scan $pubflud {%[^:]:%s} maxr maxt
if {$n >= $maxr} {
if {[unixtime] - $ts <= $maxt} {return}
set n 1; set ts [unixtime]
}
} {
set n 1; set ts [unixtime]
}
set pcount [list $ts $n]
set num [lindex [split $text] 1]
set feed [lindex [split $text] 0]
if {$text == ""} {
foreach {key value} [array get feeds] {
scan $key {%[^:]:%s} name channel
if {[string eq -noc $chan $channel]} {
lappend names $name
}
}
if {[info exists names]} {
set names [join $names {, }]
puthelp "notice $nick :feed(s) for $chan: $names"
puthelp "notice $nick :type $::lastbind <feed> \[index#\]"
} {
puthelp "notice $nick :no feed(s) for $chan"
}
return 1
}
if {![info exists news($feed:$chan)]} {
puthelp "notice $nick :no news from $feed on $chan"
return 1
}
if {$num == ""} {
set idx 1
if {$source($feed:$chan) != ""} {
set title $source($feed:$chan)
} {
set title [lindex $feeds($feed:$chan) 1]
}
puthelp "notice $nick :News source: \002$title\002"
foreach item $news($feed:$chan) {
puthelp "notice $nick :($idx) [lindex $item 0]"
incr idx
}
return 1
} elseif {![string is integer $num]} {
puthelp "notice $nick :news index must be number"
return 1
}
if {$num < 1 || $num > [llength $news($feed:$chan)]} {
puthelp "notice $nick :no such news index, try $::lastbind $feed"
return 1
} {
set idx [expr {$num-1}]
puthelp "notice $nick :......title($num): [lindex [lindex $news($feed:$chan) $idx] 0]"
puthelp "notice $nick :description($num): [lindex [lindex $news($feed:$chan) $idx] 2]"
puthelp "notice $nick :.......link($num): [lindex [lindex $news($feed:$chan) $idx] 1]"
return 1
}
}
# this proc courtesy of RS,
# from http://wiki.tcl.tk/775
proc b64en str {
binary scan $str B* bits
switch [expr {[string length $bits]%6}] {
0 {set tail ""}
2 {append bits 0000; set tail ==}
4 {append bits 00; set tail =}
}
return [string map {
000000 A 000001 B 000010 C 000011 D 000100 E 000101 F
000110 G 000111 H 001000 I 001001 J 001010 K 001011 L
001100 M 001101 N 001110 O 001111 P 010000 Q 010001 R
010010 S 010011 T 010100 U 010101 V 010110 W 010111 X
011000 Y 011001 Z 011010 a 011011 b 011100 c 011101 d
011110 e 011111 f 100000 g 100001 h 100010 i 100011 j
100100 k 100101 l 100110 m 100111 n 101000 o 101001 p
101010 q 101011 r 101100 s 101101 t 101110 u 101111 v
110000 w 110001 x 110010 y 110011 z 110100 0 110101 1
110110 2 110111 3 111000 4 111001 5 111010 6 111011 7
111100 8 111101 9 111110 + 111111 /
} $bits]$tail
}
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
}
}
www.irc-pacifique.com/ ou depuis un mirc client /server -m irc-pacifique.com server fun cool et tolerants
