This is the code for a simple RSS Reader. It is based on David Graverauxs code TclHttpd RSS Processing and splitted in a library to do the real reading and a GUI frontend.
package provide czrss 0.1
package require snit
package require tdom
package require http
snit::type ::czrss::doc {
variable xpath
variable channel
variable items
variable url
# Konstruktor für eine bestehende URI
constructor { uri } {
puts stdout "rss::doc $uri"
set url $uri
$self load
}
method load { } {
# load xml to temporary file
set file "[ clock seconds].xml"
set out [ open $file w ]
http::geturl $url -channel $out
close $out
# load xml into dom from temporary file
set doc [ dom parse -channel [tDOM::xmlOpenFile $file] ]
set _root [ $doc documentElement ]
file delete $file
set root [$doc documentElement]
switch [getRSSVersion $doc] {
0.91 - 0.92 - 0.93 - 2.0 {
set xpath(titleXpath) {/rss/channel/title/text()}
set xpath(linkXpath) {/rss/channel/link/text()}
set xpath(imgNodeXpath) {/rss/channel/image/title}
set xpath(imgTitleXpath {/rss/channel/image/title/text()}
set xpath(imgLinkXpath) {/rss/channel/image/url/text()}
set xpath(imgWidthXpath) {/rss/channel/image/width/text()}
set xpath(imgHeightXpath) {/rss/channel/image/height/text()}
set xpath(storiesXpath) {/rss/channel/item}
set xpath(itemTitleXpath) {title/text()}
set xpath(itemLinkXpath) {link/text()}
set xpath(itemPubDateXpath) {pubDate/text()}
set xpath(itemDescXpath) {description/text()}
}
1.0 {
set xpath(titleXpath) {/rdf:RDF/*[local-name()='channel']/*[local-name()='title']/text()}
set xpath(linkXpath) {/rdf:RDF/*[local-name()='channel']/*[local-name()='link']/text()}
set xpath(imgNodeXpath) {/rdf:RDF/*[local-name()='image']}
set xpath(imgTitleXpath) {/rdf:RDF/*[local-name()='image']/*[local-name()='title']/text()}
set xpath(imgLinkXpath) {/rdf:RDF/*[local-name()='image']/*[local-name()='url']/text()}
set xpath(imgWidthXpath) {/rdf:RDF/*[local-name()='image']/*[local-name()='width']/text()}
set xpath(imgHeightXpath) {/rdf:RDF/*[local-name()='image']/*[local-name()='height']/text()}
set xpath(storiesXpath) {/rdf:RDF/*[local-name()='item']}
set xpath(itemTitleXpath) {*[local-name()='title']/text()}
set xpath(itemLinkXpath) {*[local-name()='link']/text()}
set xpath(itemPubDateXpath) {*[local-name()='pubDate']/text()}
set xpath(itemDescXpath) {*[local-name()='description']/text()}
}
default {
error "Unssupported schema [getRSSVersion $doc]"
}
}
# Channel
set cN [ $_root child 1 channel ]
set channel [::czrss::channel create %AUTO% $self $cN]
puts $channel
# Nachrichten
set items {}
set stories [$_root selectNodes $xpath(storiesXpath) ]
foreach iN $stories {
lappend items [ ::czrss::item create %AUTO% $self $iN ]
}
}
method xpath { key } {
return $xpath($key)
}
method channel {} {
return $channel
}
method items {} {
return $items
}
proc getRSSVersion {doc} {
set root [$doc documentElement]
switch [$root nodeName] {
rss {
if {[$root hasAttribute version]} {
return [$root getAttribute version]
}
# Best guess as most stuff is optional...
return 0.92
}
rdf:RDF {
return 1.0
}
default {
return 0
}
}
}
}
snit::type ::czrss::item {
variable _node
variable _doc
constructor {doc node } {
variable history
set _doc $doc
set _node $node
}
method title { } {
set xpath [$_doc xpath itemTitleXpath]
return [ ::czrss::nodeTxt $_node $xpath]
}
method link {} {
set xpath [$_doc xpath itemLinkXpath]
return [ ::czrss::nodeUri $_node $xpath]
}
method description {} {
set xpath [$_doc xpath itemDescXpath]
return [ ::czrss::nodeTxt $_node $xpath]
}
method pubDate {} {
set xpath [$_doc xpath itemPubDateXpath]
return [ ::czrss::nodeTxt $_node $xpath]
}
}
snit::type ::czrss::channel {
variable _doc
variable _root
constructor { doc root} {
set _doc $doc
set _root $root
}
method title { } {
set xpath [$_doc xpath titleXpath]
return [ ::czrss::nodeTxt $_root $xpath]
}
method imgLink {} {
set xpath [$_doc xpath imgLinkXpath]
return [ ::czrss::nodeUri $_root $xpath]
}
method imgTitle {} {
set xpath [$_doc xpath imgTitleXpath]
return [ ::czrss::nodeUri $_root $xpath]
}
method imgWidth {} {
set xpath [$_doc xpath imgWidthXpath]
return [ ::czrss::nodeTxt $_root $xpath]
}
method imgHeight {} {
set xpath [$_doc xpath imgHeightXpath]
return [ ::czrss::nodeTxt $_root $xpath]
}
}
namespace eval ::czrss {
proc encUri {uri} {
return [string map { & %26 } $uri]
}
proc encTxt {txt} {
return [string map { & & < < > > } $txt]
}
proc nodeUri {node xpath} {
if {[$node selectNode $xpath] != ""} {
# Only if there is a lonely &, quote it back to an entity.
return [encUri [[$node selectNode $xpath] nodeValue]]
} else {
return ""
}
}
proc nodeTxt {node xpath} {
if {[$node selectNode $xpath] != ""} {
return [[$node selectNode $xpath] nodeValue]
} else {
return ""
}
}
}