|
|
@@ -0,0 +1,1090 @@
|
|
|
+# TCL Script to retrieve queries from Quakeservers.net (they come as rss)
|
|
|
+# Copyright (C) 2004 Paul-Dieter Klumpp
|
|
|
+#
|
|
|
+# This program is free software; you can redistribute it and/or
|
|
|
+# modify it under the terms of the GNU General Public License
|
|
|
+# as published by the Free Software Foundation; either version 2
|
|
|
+# of the License, or (at your option) any later version.
|
|
|
+#
|
|
|
+# This program is distributed in the hope that it will be useful,
|
|
|
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
+# GNU General Public License for more details.
|
|
|
+#
|
|
|
+# You should have received a copy of the GNU General Public License
|
|
|
+# along with this program; if not, write to the Free Software
|
|
|
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+# have a binding to call url
|
|
|
+# if binding called,
|
|
|
+# get url
|
|
|
+# if retrieved data
|
|
|
+# parse retrieved data
|
|
|
+# output to channel where called
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+namespace eval ::rss-synd {
|
|
|
+ variable rss
|
|
|
+ variable default
|
|
|
+
|
|
|
+ set rss(qservers) {
|
|
|
+ "url" "http://www.quakeservers.net/shambler_players.php?n="
|
|
|
+ "channels" "#quad.dev"
|
|
|
+ "database" "./scripts/feeds/qservers"
|
|
|
+ "output" "\[\002!qw fp\002\] @@item!player@@ (@@item!description@@ - qw://@@item!ip@@:@@item!port@@)"
|
|
|
+ "interval-or-forced" "forced"
|
|
|
+ }
|
|
|
+
|
|
|
+ set default {
|
|
|
+ "announce-output" 3
|
|
|
+ "trigger-output" 3
|
|
|
+ "remove-empty" 1
|
|
|
+ "trigger-type" 0:2
|
|
|
+ "announce-type" 0
|
|
|
+ "max-depth" 5
|
|
|
+ "evaluate-tcl" 0
|
|
|
+ "update-interval" 30
|
|
|
+ "output-order" 0
|
|
|
+ "timeout" 60000
|
|
|
+ "channels" "#channel1"
|
|
|
+ "trigger" "!rss @@feedid@@"
|
|
|
+ "output" "\[\002@@channel!title@@@@title@@\002\] @@item!title@@@@entry!title@@ - @@item!link@@@@entry!link!=href@@"
|
|
|
+ "user-agent" "Mozilla/5.0 (Windows; U; Windows NT 6.1; en-GB; rv:1.9.2.2) Gecko/20100316 Firefox/3.6.2"
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+proc ::cims::feed_get_qw_and_display {nick mask hand chan text} {
|
|
|
+
|
|
|
+ # ist im channel erlaubt?
|
|
|
+ # ist abfrageintervall eingehalten?
|
|
|
+
|
|
|
+ # lese parameter
|
|
|
+ # verändere URL entsprechend..
|
|
|
+ # verändere channel auf den aufrufenden..
|
|
|
+ # dann start feed_get
|
|
|
+ putlog "here i am: $nick $mask $hand $chan $text"
|
|
|
+
|
|
|
+ #set rss(qservers) {
|
|
|
+ # "url" "http://www.quakeservers.net/shambler_players.php?n=$params"
|
|
|
+ # "channels" "#quad.dev"
|
|
|
+ # "database" "./scripts/feeds/qservers"
|
|
|
+ # "output" "\\\[\002qw fp\002\\\] @@item!player@@ (@@item!description@@ - @@item!ip@@:@@item!port@@)"
|
|
|
+ # "interval-or-forced" "forced"
|
|
|
+ #}
|
|
|
+
|
|
|
+ set tmp_cmd [lindex ${text} 0]
|
|
|
+ set tmp_value [lindex ${text} 1]
|
|
|
+
|
|
|
+ set cmd [string tolower [mnet:kill_spaces ${tmp_cmd}]]
|
|
|
+ set value [string tolower [mnet:kill_spaces ${tmp_value}]]
|
|
|
+
|
|
|
+
|
|
|
+ if {${cmd} == "fp"} {
|
|
|
+
|
|
|
+ # check $value ... if there
|
|
|
+ if {${value} != ""} {
|
|
|
+ if {[string length ${value}] > "1"} {
|
|
|
+ set rofg [::rss-synd::feed_get $value]
|
|
|
+ if {$rofg == 666} {
|
|
|
+ mnet:put_local_msg ${chan} "Mnet! Player not found on any qw server."
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ mnet:put_local_msg ${chan} "Mnet! Searchvalue has to be longer than 1 character."
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ mnet:put_local_msg ${chan} "Mnet! No searchvalue given.."
|
|
|
+ }
|
|
|
+ return 0
|
|
|
+ }
|
|
|
+
|
|
|
+ mnet:put_local_msg ${chan} "Possible !qw commands are:"
|
|
|
+ mnet:put_local_msg ${chan} "'!qw fp xyz' to find a player named xyz"
|
|
|
+
|
|
|
+}
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+#
|
|
|
+# Feed Retrieving Functions
|
|
|
+##
|
|
|
+
|
|
|
+proc ::rss-synd::feed_get {args} {
|
|
|
+ variable rss
|
|
|
+
|
|
|
+ set i 0
|
|
|
+ foreach name [array names rss] {
|
|
|
+ if {$i == 3} { break }
|
|
|
+
|
|
|
+ array set feed $rss($name)
|
|
|
+ #putlog "currently on $rss($name)"
|
|
|
+
|
|
|
+ # PaulK: let it be called, even if quite up2date .. because it's forced.
|
|
|
+ if {($feed(updated) <= [expr { [unixtime] - ($feed(update-interval) * 60) }]) || ( $feed(interval-or-forced) == "forced" )} {
|
|
|
+
|
|
|
+ ::http::config -useragent $feed(user-agent)
|
|
|
+
|
|
|
+ set feed(type) $feed(announce-type)
|
|
|
+ set feed(headers) [list]
|
|
|
+
|
|
|
+ if {$feed(url-auth) != ""} {
|
|
|
+ lappend feed(headers) "Authorization" "Basic $feed(url-auth)"
|
|
|
+ }
|
|
|
+
|
|
|
+ if {([info exists feed(enable-gzip)]) && ($feed(enable-gzip) == 1)} {
|
|
|
+ lappend feed(headers) "Accept-Encoding" "gzip"
|
|
|
+ }
|
|
|
+
|
|
|
+ set feedlist "[array get feed] depth 0"
|
|
|
+
|
|
|
+ # PaulK: with $args
|
|
|
+ set http_token [::http::geturl "$feed(url)$args" -timeout $feed(timeout) -headers $feed(headers)]
|
|
|
+ # PaulK: finally, we can check here what errors really happened - before, with the callback, it wasn't possible HERE in this procedure. Stupid!
|
|
|
+ catch {
|
|
|
+ set callback [[namespace current]::feed_callback ${feedlist} ${http_token}]
|
|
|
+ } return_of_callback
|
|
|
+
|
|
|
+ if {$return_of_callback != ""} {
|
|
|
+ putlog "roc: $return_of_callback"
|
|
|
+ return $return_of_callback
|
|
|
+ }
|
|
|
+ ##
|
|
|
+
|
|
|
+ set feed(updated) [unixtime]
|
|
|
+ set rss($name) [array get feed]
|
|
|
+ incr i
|
|
|
+ }
|
|
|
+
|
|
|
+ unset feed
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+proc ::rss-synd::feed_callback {feedlist args} {
|
|
|
+ set token [lindex $args end]
|
|
|
+
|
|
|
+ array set feed $feedlist
|
|
|
+
|
|
|
+ # PaulK: no callback anymore, so we can comment that
|
|
|
+ upvar 0 $token state
|
|
|
+
|
|
|
+ if {[set status $state(status)] != "ok"} {
|
|
|
+ if {$status == "error"} { set status $state(error) }
|
|
|
+ putlog "\002RSS HTTP Error\002: $state(url) (State: $status)"
|
|
|
+ ::http::cleanup $token
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+
|
|
|
+ array set meta $state(meta)
|
|
|
+
|
|
|
+ if {([::http::ncode $token] == 302) || ([::http::ncode $token] == 301)} {
|
|
|
+ set feed(depth) [expr {$feed(depth) + 1 }]
|
|
|
+
|
|
|
+ if {$feed(depth) < $feed(max-depth)} {
|
|
|
+ catch {::http::geturl "$meta(Location)" -command "[namespace current]::feed_callback {$feedlist}" -timeout $feed(timeout) -headers $feed(headers)}
|
|
|
+ } else {
|
|
|
+ putlog "\002RSS HTTP Error\002: $state(url) (State: timeout, max refer limit reached)"
|
|
|
+ }
|
|
|
+
|
|
|
+ ::http::cleanup $token
|
|
|
+ return 1
|
|
|
+ } elseif {[::http::ncode $token] != 200} {
|
|
|
+ putlog "\002RSS HTTP Error\002: $state(url) ($state(http))"
|
|
|
+ ::http::cleanup $token
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+
|
|
|
+ set data [::http::data $token]
|
|
|
+
|
|
|
+ if {[info exists feed(charset)]} {
|
|
|
+ set data [encoding convertto [string tolower $feed(charset)] $data]
|
|
|
+ }
|
|
|
+
|
|
|
+ if {([info exists meta(Content-Encoding)]) && \
|
|
|
+ ([string equal $meta(Content-Encoding) "gzip"])} {
|
|
|
+ if {[catch {[namespace current]::feed_gzip $data} data] != 0} {
|
|
|
+ putlog "\002RSS Error\002: Unable to decompress \"$state(url)\": $data"
|
|
|
+ ::http::cleanup $token
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[catch {[namespace current]::xml_list_create $data} data] != 0} {
|
|
|
+ putlog "\002RSS Error\002: Unable to parse feed properly, parser returned error. \"$state(url)\""
|
|
|
+ ::http::cleanup $token
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[string length $data] == 0} {
|
|
|
+ putlog "\002RSS Error\002: Unable to parse feed properly, no data returned. \"$state(url)\""
|
|
|
+ ::http::cleanup $token
|
|
|
+ return 666
|
|
|
+ }
|
|
|
+
|
|
|
+ set odata ""
|
|
|
+ if {[catch {set odata [[namespace current]::feed_read]} error] != 0} {
|
|
|
+ putlog "\002RSS Warning\002: $error."
|
|
|
+ }
|
|
|
+
|
|
|
+ if {![[namespace current]::feed_info $data]} {
|
|
|
+ putlog "\002RSS Error\002: Invalid feed format ($state(url))!"
|
|
|
+ ::http::cleanup $token
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+
|
|
|
+ ::http::cleanup $token
|
|
|
+
|
|
|
+ if {[catch {[namespace current]::feed_write $data} error] != 0} {
|
|
|
+ putlog "\002RSS Database Error\002: $error."
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+
|
|
|
+ if {$feed(announce-output) > 0} {
|
|
|
+ [namespace current]::feed_output $data
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+#
|
|
|
+#
|
|
|
+##
|
|
|
+
|
|
|
+
|
|
|
+proc ::rss-synd::init {args} {
|
|
|
+ variable rss
|
|
|
+ variable default
|
|
|
+ variable version
|
|
|
+ variable packages
|
|
|
+
|
|
|
+ set version(number) "0.5"
|
|
|
+ set version(date) "2011-01-05"
|
|
|
+
|
|
|
+ package require http
|
|
|
+ set packages(base64) [catch {package require base64}]; # http auth
|
|
|
+ set packages(tls) [catch {package require tls}]; # https
|
|
|
+ set packages(trf) [catch {package require Trf}]; # gzip compression
|
|
|
+
|
|
|
+ foreach feed [array names rss] {
|
|
|
+ array set tmp $default
|
|
|
+ array set tmp $rss($feed)
|
|
|
+
|
|
|
+ set required [list "announce-output" "trigger-output" "max-depth" "update-interval" "timeout" "channels" "output" "user-agent" "url" "database" "trigger-type" "announce-type"]
|
|
|
+ foreach {key value} [array get tmp] {
|
|
|
+ if {[set ptr [lsearch -exact $required $key]] >= 0} {
|
|
|
+ set required [lreplace $required $ptr $ptr]
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[llength $required] == 0} {
|
|
|
+ regsub -nocase -all -- {@@feedid@@} $tmp(trigger) $feed tmp(trigger)
|
|
|
+
|
|
|
+ set ulist [regexp -nocase -inline -- {(http(?:s?))://(?:(.[^:]+:.[^@]+)?)(?:@?)(.*)} $tmp(url)]
|
|
|
+
|
|
|
+ if {[llength $ulist] == 0} {
|
|
|
+ putlog "\002RSS Error\002: Unable to parse URL, Invalid format for feed \"$feed\"."
|
|
|
+ unset rss($feed)
|
|
|
+ continue
|
|
|
+ }
|
|
|
+
|
|
|
+ set tmp(url) "[lindex $ulist 1]://[lindex $ulist 3]"
|
|
|
+
|
|
|
+ if {[lindex $ulist 1] == "https"} {
|
|
|
+ if {$packages(tls) != 0} {
|
|
|
+ putlog "\002RSS Error\002: Unable to find tls package required for https, unloaded feed \"$feed\"."
|
|
|
+ unset rss($feed)
|
|
|
+ continue
|
|
|
+ }
|
|
|
+
|
|
|
+ ::http::register https 443 ::tls::socket
|
|
|
+ }
|
|
|
+
|
|
|
+ if {(![info exists tmp(url-auth)]) || ($tmp(url-auth) == "")} {
|
|
|
+ set tmp(url-auth) ""
|
|
|
+
|
|
|
+ if {[lindex $ulist 2] != ""} {
|
|
|
+ if {$packages(base64) != 0} {
|
|
|
+ putlog "\002RSS Error\002: Unable to find base64 package required for http authentication, unloaded feed \"$feed\"."
|
|
|
+ unset rss($feed)
|
|
|
+ continue
|
|
|
+ }
|
|
|
+
|
|
|
+ set tmp(url-auth) [::base64::encode [lindex $ulist 2]]
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[regexp {^[0123]{1}:[0123]{1}$} $tmp(trigger-type)] != 1} {
|
|
|
+ putlog "\002RSS Error\002: Invalid 'trigger-type' syntax for feed \"$feed\"."
|
|
|
+ unset rss($feed)
|
|
|
+ continue
|
|
|
+ }
|
|
|
+
|
|
|
+ set tmp(trigger-type) [split $tmp(trigger-type) ":"]
|
|
|
+
|
|
|
+ if {([info exists tmp(charset)]) && ([lsearch -exact [encoding names] [string tolower $tmp(charset)]] < 0)} {
|
|
|
+ putlog "\002RSS Error\002: Unable to load feed \"$feed\", unknown encoding \"$tmp(encoding)\"."
|
|
|
+ unset rss($feed)
|
|
|
+ continue
|
|
|
+ }
|
|
|
+
|
|
|
+ set tmp(updated) 0
|
|
|
+ if {([file exists $tmp(database)]) && ([set mtime [file mtime $tmp(database)]] < [unixtime])} {
|
|
|
+ set tmp(updated) [file mtime $tmp(database)]
|
|
|
+ }
|
|
|
+
|
|
|
+ set rss($feed) [array get tmp]
|
|
|
+ } else {
|
|
|
+ putlog "\002RSS Error\002: Unable to load feed \"$feed\", missing one or more required settings. \"[join $required ", "]\""
|
|
|
+ unset rss($feed)
|
|
|
+ }
|
|
|
+
|
|
|
+ unset tmp
|
|
|
+ }
|
|
|
+
|
|
|
+ bind evnt -|- prerehash [namespace current]::deinit
|
|
|
+ #bind time -|- {* * * * *} [namespace current]::feed_get
|
|
|
+ bind pub - !qw ::cims::feed_get_qw_and_display
|
|
|
+ bind pubm -|- {* *} [namespace current]::trigger
|
|
|
+ bind msgm -|- {*} [namespace current]::trigger
|
|
|
+
|
|
|
+ putlog "\002RSS Syndication Script v$version(number)\002 ($version(date)): Loaded."
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::deinit {args} {
|
|
|
+ catch {unbind evnt -|- prerehash [namespace current]::deinit}
|
|
|
+ catch {unbind time -|- {* * * * *} [namespace current]::feed_get}
|
|
|
+ catch {unbind pub - !qw [namespace current]::feed_get_qw_and_display}
|
|
|
+ catch {unbind pubm -|- {* *} [namespace current]::trigger}
|
|
|
+ catch {unbind msgm -|- {*} [namespace current]::trigger}
|
|
|
+
|
|
|
+ foreach child [namespace children] {
|
|
|
+ catch {[set child]::deinit}
|
|
|
+ }
|
|
|
+
|
|
|
+ namespace delete [namespace current]
|
|
|
+}
|
|
|
+
|
|
|
+#
|
|
|
+# Trigger Function
|
|
|
+##
|
|
|
+
|
|
|
+proc ::rss-synd::trigger {nick user handle args} {
|
|
|
+ variable rss
|
|
|
+ variable default
|
|
|
+
|
|
|
+ set i 0
|
|
|
+ set chan ""
|
|
|
+ if {[llength $args] == 2} {
|
|
|
+ set chan [lindex $args 0]
|
|
|
+ incr i
|
|
|
+ }
|
|
|
+ set text [lindex $args $i]
|
|
|
+
|
|
|
+ array set tmp $default
|
|
|
+
|
|
|
+ if {[info exists tmp(trigger)]} {
|
|
|
+ regsub -all -- {@@(.*?)@@} $tmp(trigger) "" tmp_trigger
|
|
|
+ set tmp_trigger [string trimright $tmp_trigger]
|
|
|
+
|
|
|
+ if {[string equal -nocase $text $tmp_trigger]} {
|
|
|
+ set list_feeds [list]
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ unset -nocomplain tmp tmp_trigger
|
|
|
+
|
|
|
+ foreach name [array names rss] {
|
|
|
+ array set feed $rss($name)
|
|
|
+
|
|
|
+ if {(![info exists list_feeds]) && \
|
|
|
+ ([string equal -nocase $text $feed(trigger)])} {
|
|
|
+ if {(![[namespace current]::check_channel $feed(channels) $chan]) && \
|
|
|
+ ([string length $chan] != 0)} {
|
|
|
+ continue
|
|
|
+ }
|
|
|
+
|
|
|
+ set feed(nick) $nick
|
|
|
+
|
|
|
+ if {$chan != ""} {
|
|
|
+ set feed(type) [lindex $feed(trigger-type) 0]
|
|
|
+ set feed(channels) $chan
|
|
|
+ } else {
|
|
|
+ set feed(type) [lindex $feed(trigger-type) 1]
|
|
|
+ set feed(channels) ""
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[catch {set data [[namespace current]::feed_read]} error] == 0} {
|
|
|
+ if {![[namespace current]::feed_info $data]} {
|
|
|
+ putlog "\002RSS Error\002: Invalid feed database file format ($feed(database))!"
|
|
|
+ return
|
|
|
+ }
|
|
|
+
|
|
|
+ if {$feed(trigger-output) > 0} {
|
|
|
+ set feed(announce-output) $feed(trigger-output)
|
|
|
+
|
|
|
+ [namespace current]::feed_output $data
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ putlog "\002RSS Warning\002: $error."
|
|
|
+ }
|
|
|
+ } elseif {[info exists list_feeds]} {
|
|
|
+ if {$chan != ""} {
|
|
|
+ # triggered from a channel
|
|
|
+ if {[[namespace current]::check_channel $feed(channels) $chan]} {
|
|
|
+ lappend list_feeds $feed(trigger)
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ # triggered from a privmsg
|
|
|
+ foreach tmp_chan $feed(channels) {
|
|
|
+ if {([catch {botonchan $tmp_chan}] == 0) && \
|
|
|
+ ([onchan $nick $tmp_chan])} {
|
|
|
+ lappend list_feeds $feed(trigger)
|
|
|
+ continue
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[info exists list_feeds]} {
|
|
|
+ if {[llength $list_feeds] == 0} {
|
|
|
+ lappend list_feeds "None"
|
|
|
+ }
|
|
|
+
|
|
|
+ lappend list_msgs "Available feeds: [join $list_feeds ", "]."
|
|
|
+
|
|
|
+ if {$chan != ""} {
|
|
|
+ set list_type [lindex $feed(trigger-type) 0]
|
|
|
+ set list_targets $chan
|
|
|
+ } else {
|
|
|
+ set list_type [lindex $feed(trigger-type) 1]
|
|
|
+ set list_targets ""
|
|
|
+ }
|
|
|
+
|
|
|
+ [namespace current]::feed_msg $list_type $list_msgs list_targets $nick
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+
|
|
|
+proc ::rss-synd::feed_info {data {target "feed"}} {
|
|
|
+ upvar 1 $target feed
|
|
|
+ set length [[namespace current]::xml_get_info $data [list -1 "*"]]
|
|
|
+
|
|
|
+ for {set i 0} {$i < $length} {incr i} {
|
|
|
+ set type [[namespace current]::xml_get_info $data [list $i "*"] "name"]
|
|
|
+
|
|
|
+ # tag-name: the name of the element that contains each article and its data
|
|
|
+ # tag-list: the position in the xml structure where all 'tag-name' reside
|
|
|
+ switch [string tolower $type] {
|
|
|
+ rss {
|
|
|
+ # RSS v0.9x & x2.0
|
|
|
+ set feed(tag-list) [list 0 "channel"]
|
|
|
+ set feed(tag-name) "item"
|
|
|
+ break
|
|
|
+ }
|
|
|
+ rdf:rdf {
|
|
|
+ # RSS v1.0
|
|
|
+ set feed(tag-list) [list]
|
|
|
+ set feed(tag-name) "item"
|
|
|
+ break
|
|
|
+ }
|
|
|
+ feed {
|
|
|
+ # ATOM
|
|
|
+ set feed(tag-list) [list]
|
|
|
+ set feed(tag-name) "entry"
|
|
|
+ break
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if {![info exists feed(tag-list)]} {
|
|
|
+ return 0
|
|
|
+ }
|
|
|
+
|
|
|
+ set feed(tag-feed) [list 0 $type]
|
|
|
+
|
|
|
+ return 1
|
|
|
+}
|
|
|
+
|
|
|
+# decompress gzip formatted data
|
|
|
+proc ::rss-synd::feed_gzip {cdata} {
|
|
|
+ variable packages
|
|
|
+
|
|
|
+ if {(![info exists packages(trf)]) || \
|
|
|
+ ($packages(trf) != 0)} {
|
|
|
+ error "Trf package not found."
|
|
|
+ }
|
|
|
+
|
|
|
+ # remove the 10 byte gzip header and 8 byte footer
|
|
|
+ set cdata [string range $cdata 10 [expr { [string length $cdata] - 9 } ]]
|
|
|
+
|
|
|
+ # decompress the raw data
|
|
|
+ if {[catch {zip -mode decompress -nowrap 1 $cdata} data] != 0} {
|
|
|
+ error $data
|
|
|
+ }
|
|
|
+
|
|
|
+ return $data
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::feed_read { } {
|
|
|
+ upvar 1 feed feed
|
|
|
+
|
|
|
+ if {[catch {open $feed(database) "r"} fp] != 0} {
|
|
|
+ error $fp
|
|
|
+ }
|
|
|
+
|
|
|
+ set data [read -nonewline $fp]
|
|
|
+
|
|
|
+ close $fp
|
|
|
+
|
|
|
+ return $data
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::feed_write {data} {
|
|
|
+ upvar 1 feed feed
|
|
|
+
|
|
|
+ if {[catch {open $feed(database) "w+"} fp] != 0} {
|
|
|
+ error $fp
|
|
|
+ }
|
|
|
+
|
|
|
+ set data [string map { "\n" "" "\r" "" } $data]
|
|
|
+
|
|
|
+ puts -nonewline $fp $data
|
|
|
+
|
|
|
+ close $fp
|
|
|
+}
|
|
|
+
|
|
|
+#
|
|
|
+# XML Functions
|
|
|
+##
|
|
|
+
|
|
|
+proc ::rss-synd::xml_list_create {xml_data} {
|
|
|
+ set xml_list [list]
|
|
|
+ set ns_current [namespace current]
|
|
|
+
|
|
|
+ set ptr 0
|
|
|
+ while {[set tag_start [${ns_current}::xml_get_position $xml_data $ptr]] != ""} {
|
|
|
+ set tag_start_first [lindex $tag_start 0]
|
|
|
+ set tag_start_last [lindex $tag_start 1]
|
|
|
+
|
|
|
+ set tag_string [string range $xml_data $tag_start_first $tag_start_last]
|
|
|
+
|
|
|
+ # move the pointer to the next character after the current tag
|
|
|
+ set last_ptr $ptr
|
|
|
+ set ptr [expr { $tag_start_last + 2 }]
|
|
|
+
|
|
|
+ array set tag [list]
|
|
|
+ # match 'special' tags that dont close
|
|
|
+ if {[regexp -nocase -- {^!(\[CDATA|--|DOCTYPE)} $tag_string]} {
|
|
|
+ set tag_data $tag_string
|
|
|
+
|
|
|
+ regexp -nocase -- {^!\[CDATA\[(.*?)\]\]$} $tag_string -> tag_data
|
|
|
+ regexp -nocase -- {^!--(.*?)--$} $tag_string -> tag_data
|
|
|
+
|
|
|
+ if {[info exists tag_data]} {
|
|
|
+ set tag(data) [${ns_current}::xml_escape $tag_data]
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ # we should only ever encounter opening tags, if we hit a closing one somethings wrong
|
|
|
+ if {[string match {[/]*} $tag_string]} {
|
|
|
+ putlog "\002RSS Malformed Feed\002: Tag not open: \"<$tag_string>\" ($tag_start_first => $tag_start_last)"
|
|
|
+ continue
|
|
|
+ }
|
|
|
+
|
|
|
+ # split up the tag name and attributes
|
|
|
+ regexp -- {(.[^ \/\n\r]*)(?: |\n|\r\n|\r|)(.*?)$} $tag_string -> tag_name tag_args
|
|
|
+ set tag(name) [${ns_current}::xml_escape $tag_name]
|
|
|
+
|
|
|
+ # split up all of the tags attributes
|
|
|
+ set tag(attrib) [list]
|
|
|
+ if {[string length $tag_args] > 0} {
|
|
|
+ set values [regexp -inline -all -- {(?:\s*|)(.[^=]*)=["'](.[^"']*)["']} $tag_args]
|
|
|
+
|
|
|
+ foreach {r_match r_tag r_value} $values {
|
|
|
+ lappend tag(attrib) [${ns_current}::xml_escape $r_tag] [${ns_current}::xml_escape $r_value]
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # find the end tag of non-self-closing tags
|
|
|
+ if {(![regexp {(\?|!|/)(\s*)$} $tag_args]) || \
|
|
|
+ (![string match "\?*" $tag_string])} {
|
|
|
+ set tmp_num 1
|
|
|
+ set tag_success 0
|
|
|
+ set tag_end_last $ptr
|
|
|
+
|
|
|
+ # find the correct closing tag if there are nested elements
|
|
|
+ # with the same name
|
|
|
+ while {$tmp_num > 0} {
|
|
|
+ # search for a possible closing tag
|
|
|
+ set tag_success [regexp -indices -start $tag_end_last -- "</$tag_name>" $xml_data tag_end]
|
|
|
+
|
|
|
+ set last_tag_end_last $tag_end_last
|
|
|
+
|
|
|
+ set tag_end_first [lindex $tag_end 0]
|
|
|
+ set tag_end_last [lindex $tag_end 1]
|
|
|
+
|
|
|
+ # check to see if there are any NEW opening tags within the
|
|
|
+ # previous closing tag and the new closing one
|
|
|
+ incr tmp_num [regexp -all -- "<$tag_name\(\[\\s\\t\\n\\r\]+\(\[^/>\]*\)?\)?>" [string range $xml_data $last_tag_end_last $tag_end_last]]
|
|
|
+
|
|
|
+ incr tmp_num -1
|
|
|
+ }
|
|
|
+
|
|
|
+ if {$tag_success == 0} {
|
|
|
+ putlog "\002RSS Malformed Feed\002: Tag not closed: \"<$tag_name>\""
|
|
|
+ return
|
|
|
+ }
|
|
|
+
|
|
|
+ # set the pointer to after the last closing tag
|
|
|
+ set ptr [expr { $tag_end_last + 1 }]
|
|
|
+
|
|
|
+ # remember tag_start*'s character index doesnt include the tag start and end characters
|
|
|
+ set xml_sub_data [string range $xml_data [expr { $tag_start_last + 2 }] [expr { $tag_end_first - 1 }]]
|
|
|
+
|
|
|
+ # recurse the data within the currently open tag
|
|
|
+ set result [${ns_current}::xml_list_create $xml_sub_data]
|
|
|
+
|
|
|
+ # set the list data returned from the recursion we just performed
|
|
|
+ if {[llength $result] > 0} {
|
|
|
+ set tag(children) $result
|
|
|
+
|
|
|
+ # set the current data we have because we're already at the end of a branch
|
|
|
+ # (ie: the recursion didnt return any data)
|
|
|
+ } else {
|
|
|
+ set tag(data) [${ns_current}::xml_escape $xml_sub_data]
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # insert any plain data that appears before the current element
|
|
|
+ if {$last_ptr != [expr { $tag_start_first - 1 }]} {
|
|
|
+ lappend xml_list [list "data" [${ns_current}::xml_escape [string range $xml_data $last_ptr [expr { $tag_start_first - 2 }]]]]
|
|
|
+ }
|
|
|
+
|
|
|
+ # inset tag data
|
|
|
+ lappend xml_list [array get tag]
|
|
|
+
|
|
|
+ unset tag
|
|
|
+ }
|
|
|
+
|
|
|
+ # if there is still plain data left add it
|
|
|
+ if {$ptr < [string length $xml_data]} {
|
|
|
+ lappend xml_list [list "data" [${ns_current}::xml_escape [string range $xml_data $ptr end]]]
|
|
|
+ }
|
|
|
+
|
|
|
+ return $xml_list
|
|
|
+}
|
|
|
+
|
|
|
+# simple escape function
|
|
|
+proc ::rss-synd::xml_escape {string} {
|
|
|
+ regsub -all -- {([\{\}])} $string {\\\1} string
|
|
|
+
|
|
|
+ return $string
|
|
|
+}
|
|
|
+
|
|
|
+# this function is to replace:
|
|
|
+# regexp -indices -start $ptr {<(!\[CDATA\[.+?\]\]|!--.+?--|!DOCTYPE.+?|.+?)>} $xml_data -> tag_start
|
|
|
+# which doesnt work correctly with tcl's re_syntax
|
|
|
+proc ::rss-synd::xml_get_position {xml_data ptr} {
|
|
|
+ set tag_start [list -1 -1]
|
|
|
+
|
|
|
+ regexp -indices -start $ptr {<(.+?)>} $xml_data -> tmp(tag)
|
|
|
+ regexp -indices -start $ptr {<(!--.*?--)>} $xml_data -> tmp(comment)
|
|
|
+ regexp -indices -start $ptr {<(!DOCTYPE.+?)>} $xml_data -> tmp(doctype)
|
|
|
+ regexp -indices -start $ptr {<(!\[CDATA\[.+?\]\])>} $xml_data -> tmp(cdata)
|
|
|
+
|
|
|
+ # 'tag' regexp should be compared last
|
|
|
+ foreach name [lsort [array names tmp]] {
|
|
|
+ set tmp_s [split $tmp($name)]
|
|
|
+ if {( ([lindex $tmp_s 0] < [lindex $tag_start 0]) && \
|
|
|
+ ([lindex $tmp_s 0] > -1) ) || \
|
|
|
+ ([lindex $tag_start 0] == -1)} {
|
|
|
+ set tag_start $tmp($name)
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if {([lindex $tag_start 0] == -1) || \
|
|
|
+ ([lindex $tag_start 1] == -1)} {
|
|
|
+ set tag_start ""
|
|
|
+ }
|
|
|
+
|
|
|
+ return $tag_start
|
|
|
+}
|
|
|
+
|
|
|
+# recursivly flatten all data without tags or attributes
|
|
|
+proc ::rss-synd::xml_list_flatten {xml_list {level 0}} {
|
|
|
+ set xml_string ""
|
|
|
+
|
|
|
+ foreach e_list $xml_list {
|
|
|
+ if {[catch {array set e_array $e_list}] != 0} {
|
|
|
+ return $xml_list
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[info exists e_array(children)]} {
|
|
|
+ append xml_string [[namespace current]::xml_list_flatten $e_array(children) [expr { $level + 1 }]]
|
|
|
+ } elseif {[info exists e_array(data)]} {
|
|
|
+ append xml_string $e_array(data)
|
|
|
+ }
|
|
|
+
|
|
|
+ unset e_array
|
|
|
+ }
|
|
|
+
|
|
|
+ return $xml_string
|
|
|
+}
|
|
|
+
|
|
|
+# returns information on a data structure when given a path.
|
|
|
+# paths can be specified using: [struct number] [struct name] <...>
|
|
|
+proc ::rss-synd::xml_get_info {xml_list path {element "data"}} {
|
|
|
+ set i 0
|
|
|
+
|
|
|
+ foreach {t_data} $xml_list {
|
|
|
+ array set t_array $t_data
|
|
|
+
|
|
|
+ # if the name doesnt exist set it so we can still reference the data
|
|
|
+ # using the 'stuct name' *
|
|
|
+ if {![info exists t_array(name)]} {
|
|
|
+ set t_array(name) ""
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[string match -nocase [lindex $path 1] $t_array(name)]} {
|
|
|
+
|
|
|
+ if {$i == [lindex $path 0]} {
|
|
|
+ set result ""
|
|
|
+
|
|
|
+ if {([llength $path] == 2) && \
|
|
|
+ ([info exists t_array($element)])} {
|
|
|
+ set result $t_array($element)
|
|
|
+ } elseif {[info exists t_array(children)]} {
|
|
|
+ # shift the first path reference of the front of the path and recurse
|
|
|
+ set result [[namespace current]::xml_get_info $t_array(children) [lreplace $path 0 1] $element]
|
|
|
+ }
|
|
|
+
|
|
|
+ return $result
|
|
|
+ }
|
|
|
+
|
|
|
+ incr i
|
|
|
+ }
|
|
|
+
|
|
|
+ unset t_array
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[lindex $path 0] == -1} {
|
|
|
+ return $i
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+# converts 'args' into a list in the same order
|
|
|
+proc ::rss-synd::xml_join_tags {args} {
|
|
|
+ set list [list]
|
|
|
+
|
|
|
+ foreach tag $args {
|
|
|
+ foreach item $tag {
|
|
|
+ if {[string length $item] > 0} {
|
|
|
+ lappend list $item
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ return $list
|
|
|
+}
|
|
|
+
|
|
|
+#
|
|
|
+# Output Feed Functions
|
|
|
+##
|
|
|
+
|
|
|
+proc ::rss-synd::feed_output {data {odata ""}} {
|
|
|
+ upvar 1 feed feed
|
|
|
+ set msgs [list]
|
|
|
+
|
|
|
+ set path [[namespace current]::xml_join_tags $feed(tag-feed) $feed(tag-list) -1 $feed(tag-name)]
|
|
|
+ set count [[namespace current]::xml_get_info $data $path]
|
|
|
+
|
|
|
+ for {set i 0} {($i < $count) && ($i < $feed(announce-output))} {incr i} {
|
|
|
+ set tmpp [[namespace current]::xml_join_tags $feed(tag-feed) $feed(tag-list) $i $feed(tag-name)]
|
|
|
+ set tmpd [[namespace current]::xml_get_info $data $tmpp "children"]
|
|
|
+
|
|
|
+ if {[[namespace current]::feed_compare $odata $tmpd]} {
|
|
|
+ break
|
|
|
+ }
|
|
|
+
|
|
|
+ set tmp_msg [[namespace current]::cookie_parse $data $i]
|
|
|
+ if {(![info exists feed(output-order)]) || \
|
|
|
+ ($feed(output-order) == 0)} {
|
|
|
+ set msgs [linsert $msgs 0 $tmp_msg]
|
|
|
+ } else {
|
|
|
+ lappend msgs $tmp_msg
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ set nick [expr {[info exists feed(nick)] ? $feed(nick) : ""}]
|
|
|
+
|
|
|
+ [namespace current]::feed_msg $feed(type) $msgs $feed(channels) $nick
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::feed_msg {type msgs targets {nick ""}} {
|
|
|
+ # check if our target is a nick
|
|
|
+ if {(($nick != "") && \
|
|
|
+ ($targets == "")) || \
|
|
|
+ ([regexp -- {[23]} $type])} {
|
|
|
+ set targets $nick
|
|
|
+ }
|
|
|
+
|
|
|
+ foreach msg $msgs {
|
|
|
+ foreach chan $targets {
|
|
|
+ if {([catch {botonchan $chan}] == 0) || \
|
|
|
+ ([regexp -- {^[#&]} $chan] == 0)} {
|
|
|
+ foreach line [split $msg "\n"] {
|
|
|
+ if {($type == 1) || ($type == 3)} {
|
|
|
+ putserv "NOTICE $chan :$line"
|
|
|
+ } else {
|
|
|
+ putserv "PRIVMSG $chan :$line"
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::feed_compare {odata data} {
|
|
|
+ if {$odata == ""} {
|
|
|
+ return 0
|
|
|
+ }
|
|
|
+
|
|
|
+ upvar 1 feed feed
|
|
|
+ array set ofeed [list]
|
|
|
+ [namespace current]::feed_info $odata "ofeed"
|
|
|
+
|
|
|
+ if {[array size ofeed] == 0} {
|
|
|
+ putlog "\002RSS Error\002: Invalid feed format ($feed(database))!"
|
|
|
+ return 0
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[string equal -nocase [lindex $feed(tag-feed) 1] "feed"]} {
|
|
|
+ set cmp_items [list {0 "id"} "children" "" 3 {0 "link"} "attrib" "href" 2 {0 "title"} "children" "" 1]
|
|
|
+ } else {
|
|
|
+ set cmp_items [list {0 "guid"} "children" "" 3 {0 "link"} "children" "" 2 {0 "title"} "children" "" 1]
|
|
|
+ }
|
|
|
+
|
|
|
+ set path [[namespace current]::xml_join_tags $ofeed(tag-feed) $ofeed(tag-list) -1 $ofeed(tag-name)]
|
|
|
+ set count [[namespace current]::xml_get_info $odata $path]
|
|
|
+
|
|
|
+ for {set i 0} {$i < $count} {incr i} {
|
|
|
+ # extract the current article from the database
|
|
|
+ set tmpp [[namespace current]::xml_join_tags $ofeed(tag-feed) $ofeed(tag-list) $i $ofeed(tag-name)]
|
|
|
+ set tmpd [[namespace current]::xml_get_info $odata $tmpp "children"]
|
|
|
+
|
|
|
+ set w 0; # weight value
|
|
|
+ set m 0; # item tag matches
|
|
|
+ foreach {cmp_path cmp_element cmp_attrib cmp_weight} $cmp_items {
|
|
|
+ # try and extract the tag info from the current article
|
|
|
+ set oresult [[namespace current]::xml_get_info $tmpd $cmp_path $cmp_element]
|
|
|
+ if {$cmp_element == "attrib"} {
|
|
|
+ array set tmp $oresult
|
|
|
+ catch {set oresult $tmp($cmp_attrib)}
|
|
|
+ unset tmp
|
|
|
+ }
|
|
|
+
|
|
|
+ # if the tag doesnt exist in the article ignore it
|
|
|
+ if {$oresult == ""} { continue }
|
|
|
+
|
|
|
+ incr m
|
|
|
+
|
|
|
+ # extract the tag info from the current article
|
|
|
+ set result [[namespace current]::xml_get_info $data $cmp_path $cmp_element]
|
|
|
+ if {$cmp_element == "attrib"} {
|
|
|
+ array set tmp $result
|
|
|
+ catch {set result $tmp($cmp_attrib)}
|
|
|
+ unset tmp
|
|
|
+ }
|
|
|
+
|
|
|
+ if {[string equal -nocase $oresult $result]} {
|
|
|
+ set w [expr { $w + $cmp_weight }]
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # value of 100 or more means its a match
|
|
|
+ if {($m > 0) && \
|
|
|
+ ([expr { round(double($w) / double($m) * 100) }] >= 100)} {
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ return 0
|
|
|
+}
|
|
|
+
|
|
|
+#
|
|
|
+# Cookie Parsing Functions
|
|
|
+##
|
|
|
+
|
|
|
+proc ::rss-synd::cookie_parse {data current} {
|
|
|
+ upvar 1 feed feed
|
|
|
+ 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 equal -nocase $feed(tag-name) [lindex $cookie 1]]} {
|
|
|
+ set cookie [[namespace current]::xml_join_tags $feed(tag-list) [lreplace $cookie $index $index $current]]
|
|
|
+ }
|
|
|
+
|
|
|
+ set cookie [[namespace current]::xml_join_tags $feed(tag-feed) $cookie]
|
|
|
+
|
|
|
+ if {[set tmp [[namespace current]::cookie_replace $cookie $data]] != ""} {
|
|
|
+ set tmp [[namespace current]::xml_list_flatten $tmp]
|
|
|
+
|
|
|
+ regsub -all -- {([\"\$\[\]\{\}\(\)\\])} $match {\\\1} match
|
|
|
+ regsub -- $match $output "[string map { "&" "\\\x26" } [[namespace current]::html_decode $eval $tmp]]" output
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ # remove empty cookies
|
|
|
+ if {(![info exists feed(remove-empty)]) || ($feed(remove-empty) == 1)} {
|
|
|
+ regsub -nocase -all -- "@@.*?@@" $output "" output
|
|
|
+ }
|
|
|
+
|
|
|
+ # evaluate tcl code
|
|
|
+ if {$eval == 1} {
|
|
|
+ if {[catch {set output [subst $output]} error] != 0} {
|
|
|
+ putlog "\002RSS Eval Error\002: $error"
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ return $output
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::cookie_replace {cookie data} {
|
|
|
+ set element "children"
|
|
|
+
|
|
|
+ set tags [list]
|
|
|
+ foreach {num section} $cookie {
|
|
|
+ if {[string equal "=" [string range $section 0 0]]} {
|
|
|
+ set attrib [string range $section 1 end]
|
|
|
+ set element "attrib"
|
|
|
+ break
|
|
|
+ } else {
|
|
|
+ lappend tags $num $section
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ set return [[namespace current]::xml_get_info $data $tags $element]
|
|
|
+
|
|
|
+ if {[string equal -nocase "attrib" $element]} {
|
|
|
+ array set tmp $return
|
|
|
+
|
|
|
+ if {[catch {set return $tmp($attrib)}] != 0} {
|
|
|
+ return
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ return $return
|
|
|
+}
|
|
|
+
|
|
|
+#
|
|
|
+# Misc Functions
|
|
|
+##
|
|
|
+
|
|
|
+proc ::rss-synd::html_decode {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 -- {&#(\d+);} $data {[subst -nocomm -novar [format \\\u%04x [scan \1 %d]]]} data
|
|
|
+ regsub -all -- {&#x(\w+);} $data {[format %c [scan \1 %x]]} data
|
|
|
+ regsub -all -- {&([0-9a-zA-Z#]*);} $data {[if {[catch {set tmp $chars(\1)} char] == 0} { set tmp }]} data
|
|
|
+ regsub -all -- {&([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 {[incr loop] == 1} {
|
|
|
+ set data [[namespace current]::html_decode 0 $data $loop]
|
|
|
+ }
|
|
|
+
|
|
|
+ return $data
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::check_channel {chanlist chan} {
|
|
|
+ foreach match [split $chanlist] {
|
|
|
+ if {[string equal -nocase $match $chan]} {
|
|
|
+ return 1
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ return 0
|
|
|
+}
|
|
|
+
|
|
|
+proc ::rss-synd::urldecode {str} {
|
|
|
+ regsub -all -- {([\"\$\[\]\{\}\(\)\\])} $str {\\\1} str
|
|
|
+
|
|
|
+ regsub -all -- {%([aAbBcCdDeEfF0-9][aAbBcCdDeEfF0-9]);?} $str {[format %c [scan \1 %x]]} str
|
|
|
+
|
|
|
+ return [subst $str]
|
|
|
+}
|
|
|
+
|
|
|
+::rss-synd::init
|
