| LiDeR | 18 Ağustos 2007 20:15 |
Yanıt: haber.tcl ariorum..
işte kodları txt dosyasını atın ve tcl olarak kaydedin.. PHP- Kodu:
# Eggdrop RSS Syndication
# -----------------------
# Date: 2006-??-??
# Version: v0.3 beta 1
# Author(s): Andrew Scott <
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
>
# Website: http://labs.wizzer-it.com/
#
#
# Start of Settings
#
namespace eval ::rss-synd {
variable rss
# the \'s are in the examples below use this one as a template.
set rss(sabah) {
"url" "
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
style="color: #0000BB"><?...?> tags
if {[string match {[!\?]*} $tmp(string)]} {
continue
}
# we should only ever encounter opening tags, if we hit a closing one somethings wrong.
if {[string match {[/]*} $tmp(string)]} {
putlog "\002Malformed Feed\002: Tag not open: \"<$tmp(string)>\" ([join $tmp(sindices) " => "])"
continue
}
set match [regexp -inline -- {(.[^ \/\n\r>]*)(?: |\n|\r\n|\r|)(.[^>]*|)} $tmp(string)]
set tag(name) [lindex $match 1]
set tag(data) ""
# get all of the tags attributes
set tag(attrib) [list]
if {[string length [lindex $match 2]] > 0} {
set values [regexp -inline -all -- {(?:\s*|)(.[^=]*)="(.[^"]*)"} [lindex $match 2]]
foreach {regmatch regtag regval} $values {
lappend tag(attrib) $regtag $regval
}
}
# find the end tag of non-self-closing tags
if {![regexp {/(\s*)$} [lindex $match 2]]} {
set loop 1
# loop to check we're finding the right closing tag
while {$loop == 1} {
set loop 0
regexp -indices -start $ptr "</[lindex $match 1]>" $data tmp(eindices)
set tptr $ptr
set ptr [lindex $tmp(eindices) 1]
# there is a tag with the same name inside the current one, find the next
# closing tag.
if {[regexp -indices -start $tptr -- "<[lindex $match 1]>" $data tindices]} {
if {[lindex $tindices 0] < [lindex $tmp(eindices) 1]} {
set loop 1
}
}
}
catch {unset tptr tindices subdata}
# errors sometimes occure here, not sure why, but im guessing its caused by
# downloading an incomplete feed. the problem has only occured for me
# a couple of time and it was on the same feed. I didnt manage to trace
# the problem properly. Its probably a good idea to create crash logging
# for the parser so i can debug stuff properly.
set subdata [string range $data [expr { [lindex $tmp(sindices) 1] + 1 }] [expr { [lindex $tmp(eindices) 0] - 1 }]]
if {[regexp -nocase -- {^(?:\s*)<!\[CDATA\[} $subdata]} {
set cdata [regexp -inline -all -nocase -- {<!\[CDATA\[(.[^\]]*)\]\]>} $subdata]
set subdata ""
foreach {cdmatch cddata} $cdata {
append subdata " $cddata"
}
}
set result [list]
# recurse the data within the currently open tag
if {![info exists cdata]} {
set result [[namespace current]::xmlCreateList $subdata]
}
catch {unset cdata}
# set the list data returned from the recursion we just performed
if {[llength $result] > 0} {
set tag(data) $result
# set the current data we have because were already at the end of a branch
# (ie: the recursion didnt return any data)
} else {
set tag(data) $subdata
}
}
lappend news [array get tag]
# reset the values
set tmp(sindices) [list]
set tmp(eindices) [list]
}
return $news
}
proc ::rss-synd::xmlGetInfo {data tags {element ""}} {
set i 0
foreach {tdata} $data {
array set tarray $tdata
if {[string match -nocase [lindex $tags 1] $tarray(name)]} {
if {$i == [lindex $tags 0]} {
if {[llength $tags] == 2} {
if {[string length $element] > 0} {
return $tarray($element)
} else {
return $tdata
}
} else {
return [[namespace current]::xmlGetInfo $tarray(data) [lreplace $tags 0 1] $element]
}
} else {
incr i
}
}
}
if {[lindex $tags 0] == -1} {
return $i
}
}
proc ::rss-synd::xmlJoinTags {args} {
set list [list]
foreach tag $args {
foreach item $tag {
if {[string length $item] > 0} {
lappend list $item
}
}
}
return $list
}
proc ::rss-synd::outputFeed {feedlist data {oldnews ""}} {
array set feed $feedlist
set msgs [list]
array set last[list "id" "" "title" "" "link" ""]
if {[string compare "" $oldnews] != 0} {
if {[set oldfeedlist [[namespace current]::infoFeed [list] $oldnews]] == ""} {
putlog "\002RSS Error\002: Invalid feed format ($feed(database))!"
return
}
array set oldfeed $oldfeedlist
set tmpp [[namespace current]::xmlJoinTags $oldfeed(tag-feed) $oldfeed(tag-list) 0 $oldfeed(tag-name)]
set tmpd [[namespace current]::xmlGetInfo $oldnews $tmpp "data"]
if {[string compare "" $tmpd] == 0} {
putlog "\002RSS Warning\002: Unable to compare current feed with the database, no relevant data found!"
} else {
array set last [[namespace current]::getCompareData $oldfeedlist $tmpd]
}
}
set path [[namespace current]::xmlJoinTags $feed(tag-feed) $feed(tag-list) -1 $feed(tag-name)]
set count [[namespace current]::xmlGetInfo $data $path]
for {set i 0} {($i < $count) && ($i < $feed(announce-output))} {incr i} {
set tmpp [[namespace current]::xmlJoinTags $feed(tag-feed) $feed(tag-list) $i $feed(tag-name)]
set tmpd [[namespace current]::xmlGetInfo $data $tmpp "data"]
array set current [[namespace current]::getCompareData $feedlist $tmpd]
if {[string length $last(id)] > 0} {
if {[string compare -nocase $current(id) $last(id)] == 0} {
break
}
} else {
if {[string compare -nocase $current(link) $last(link)] == 0} {
break
} elseif {[string compare -nocase $current(title) $last(title)] == 0} {
break
}
}
set msgs [linsert $msgs 0 [[namespace current]::formatOutput $feedlist $data $i]]
}
foreach msg $msgs {
# chan can be a nick if run from a trigger with the right settings
foreach chan $feed(channels) {
if {([catch {botonchan $chan}] == 0) || ([[namespace current]::isChan $chan] == 0)} {
if {($feed(type) == 1) || ($feed(type) == 3)} {
putserv "NOTICE $chan :$msg"
} else {
putserv "PRIVMSG $chan :$msg"
}
}
}
}
}
proc ::rss-synd::getCompareData {feedlist data} {
array set feed $feedlist
if {[string compare -nocase [lindex $feed(tag-feed) 1] "feed"] == 0} {
set list(title) [[namespace current]::xmlGetInfo $data[list 0 "title"] "data"]
set list(id) [[namespace current]::xmlGetInfo $data[list 0 "id"] "data"]
set list(link) ""
array set tmp [[namespace current]::xmlGetInfo $data[list 0 "link"] "attrib"]
catch {set list(link) $tmp(href)}
unset tmp
} else {
set list(title) [[namespace current]::xmlGetInfo $data[list 0 "title"] "data"]
set list(id) [[namespace current]::xmlGetInfo $data[list 0 "guid"] "data"]
set list(link) [[namespace current]::xmlGetInfo $data[list 0 "link"] "data"]
}
return [array get list]
}
proc ::rss-synd::formatOutput {feedlist data current} {
array set feed $feedlist
set output $feed(output)
set eval 0
if {([info exists feed(evaluate-tcl)]) && ($feed(evaluate-tcl) == 1)} { set eval 1 }
set matches [regexp -inline -nocase -all -- {@@(.*?)@@} $output]
foreach {match tmpc} $matches {
set tmpc [split $tmpc "!"]
set index 0
set cookie [list]
foreach piece $tmpc {
set tmpp [regexp -nocase -inline -all -- {^(.*?)\((.*?)\)|(.*?)$} $piece]
if {[lindex $tmpp 3] == ""} {
lappend cookie [lindex $tmpp 2] [lindex $tmpp 1]
} else {
lappend cookie 0 [lindex $tmpp 3]
}
}
# replace tag-item's index with the current article
if {[string compare -nocase $feed(tag-name) [lindex $cookie 1]] == 0} {
set cookie [[namespace current]::xmlJoinTags $feed(tag-list) [lreplace $cookie $index $index $current]]
}
set cookie [[namespace current]::xmlJoinTags $feed(tag-feed) $cookie]
if {[set tmp [[namespace current]::encodeCharset $feedlist [[namespace current]::replaceCookies $cookie $data]]] != ""} {
regsub -nocase -- "$match" $output "[string map { "&" "\\\x26" } [[namespace current]::decodeHtml $eval $tmp]]" output
}
}
if {(![info exists feed(remove-empty)]) || ($feed(remove-empty) == 1)} {
regsub -nocase -all -- "@@.*?@@" $output "" output
}
if {$eval == 1} {
if {[catch {set output [subst $output]} error] != 0} {
putlog "\002RSS Eval Error\002: $error"
}
}
return $output
}
proc ::rss-synd::replaceCookies {cookie data} {
set element "data"
set tags [list]
foreach {num section} $cookie {
if {[string compare "=" [string range $section 0 0]] == 0} {
set attrib [string range $section 1 end]
set element "attrib"
break
} else {
lappend tags $num $section
}
}
set return [[namespace current]::xmlGetInfo $data $tags $element]
if {[string compare -nocase "attrib" $element] == 0} {
array set tmp $return
if {[catch {set return $tmp($attrib)}] != 0} {
return
}
}
return $return
}
proc ::rss-synd::decodeHtml {eval data {loop 0}} {
array set chars {
nbsp \x20 amp \x26 quot \x22 lt \x3C
gt \x3E iexcl \xA1 cent \xA2 pound \xA3
curren \xA4 yen \xA5 brvbar \xA6 brkbar \xA6
sect \xA7 uml \xA8 die \xA8 copy \xA9
ordf \xAA laquo \xAB not \xAC shy \xAD
reg \xAE hibar \xAF macr \xAF deg \xB0
plusmn \xB1 sup2 \xB2 sup3 \xB3 acute \xB4
micro \xB5 para \xB6 middot \xB7 cedil \xB8
sup1 \xB9 ordm \xBA raquo \xBB frac14 \xBC
frac12 \xBD frac34 \xBE iquest \xBF Agrave \xC0
Aacute \xC1 Acirc \xC2 Atilde \xC3 Auml \xC4
Aring \xC5 AElig \xC6 Ccedil \xC7 Egrave \xC8
Eacute \xC9 Ecirc \xCA Euml \xCB Igrave \xCC
Iacute \xCD Icirc \xCE Iuml \xCF ETH \xD0
Dstrok \xD0 Ntilde \xD1 Ograve \xD2 Oacute \xD3
Ocirc \xD4 Otilde \xD5 Ouml \xD6 times \xD7
Oslash \xD8 Ugrave \xD9 Uacute \xDA Ucirc \xDB
Uuml \xDC Yacute \xDD THORN \xDE szlig \xDF
agrave \xE0 aacute \xE1 acirc \xE2 atilde \xE3
auml \xE4 aring \xE5 aelig \xE6 ccedil \xE7
egrave \xE8 eacute \xE9 ecirc \xEA euml \xEB
igrave \xEC iacute \xED icirc \xEE iuml \xEF
eth \xF0 ntilde \xF1 ograve \xF2 oacute \xF3
ocirc \xF4 otilde \xF5 ouml \xF6 divide \xF7
oslash \xF8 ugrave \xF9 uacute \xFA ucirc \xFB
uuml \xFC yacute \xFD thorn \xFE yuml \xFF
ensp \x20 emsp \x20 thinsp \x20 zwnj \x20
zwj \x20 lrm \x20 rlm \x20 euro \x80
sbquo \x82 bdquo \x84 hellip \x85 dagger \x86
Dagger \x87 circ \x88 permil \x89 Scaron \x8A
lsaquo \x8B OElig \x8C oelig \x8D lsquo \x91
rsquo \x92 ldquo \x93 rdquo \x94 ndash \x96
mdash \x97 tilde \x98 scaron \x9A rsaquo \x9B
Yuml \x9F apos \x27
}
regsub -all -- {<(.[^>]*)>} $data " " data
if {$eval != 1} {
regsub -all -- {([\"\$\[\]\{\}\(\)\\])} $data {\\\1} data
} else {
regsub -all -- {([\"\$\[\]\{\}\(\)\\])} $data {\\\\\\\1} data
}
regsub -all -- {&#([0-9][0-9]?[0-9]?);?} $data {[format %c [scan \1 %d]]} data
regsub -all -- {&([0-9a-zA-Z#]*);} $data {[if {[catch {set tmp $chars(\1)} char] == 0} { set tmp }]} data
regsub -all -nocase -- {&([0-9a-zA-Z#]*);} $data {[if {[catch {set tmp [string tolower $chars(\1)]} char] == 0} { set tmp }]} data
#--------------------------
#--------------------------
regsub -nocase -all -- "\\s{2,}" $data " " data
set data [subst $data]
if {$loop == 0} {
incr loop
set data [[namespace current]::decodeHtml 0 $data $loop]
}
regsub -all "ö" $data "ö" data
regsub -all "ğ" $data "ğ" data
regsub -all "ÄŸ" $data "ğ" data
regsub -all "ı" $data "ı" data
regsub -all "ı" $data "ı" data
regsub -all "ü" $data "ü" data
regsub -all "ö" $data "ö" data
regsub -all "ç" $data "ç" data
regsub -all "Ç" $data "Ç" data
regsub -all "ÅŸ" $data "ş" data
regsub -all "Ä°" $data "İ" data
regsub -all "Ä°" $data "İ" data
regsub -all "Ş" $data "Ş" data
regsub -all "Åž" $data "Ş" data
regsub -all "ş" $data "ş" data
regsub -all "Ö" $data "Ö" data
regsub -all "Ü" $data "Ü" data
regsub -all "’" $data "'" data
return $data
}
proc ::rss-synd::encodeCharset {feedlist string} {
array set feed $feedlist
if {[info exists feed(charset)]} {
set string [encoding convertto [string tolower $feed(charset)] $string]
}
return $string
}
proc ::rss-synd::channelCheck {chanlist chan} {
foreach match [split $chanlist] {
if {[string compare -nocase $match $chan] == 0} {
return 1
}
}
return 0
}
proc ::rss-synd::isChan {chan} {
if {([string index $chan 0] == "#") || ([string index $chan 0] == "&")} {
return 1
}
return 0
}
::rss-synd::init
| 