# 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