# Lie like a senator for google to stop giving me a 403..
 http::config -useragent {Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8) Gecko/20051111 Firefox/1.5}
 
 # Should the server uses this info, give it what we want to receive.
 http::config -accept "text/xml,application/xml,application/rss+xml,application/rdf+xml,application/atom+xml"
 
 # Returns the DOM object of the RSS feed.
 proc tmlrss::fetchXML {uri {recurse_limit 4}} {
 
    set token [http::geturl $uri]
    upvar #0 $token state
    if {[http::status $token] != "ok" || [http::ncode $token] != 200} {
        # was the error a redirect?  If so, do it..
        if {[http::ncode $token] == 302 && [incr recurse_limit -1] > 0} {
            array set meta $state(meta)
            set result [fetchXML $meta(Location) $recurse_limit]
            http::cleanup $token
            return $result
        }
        set err [http::code $token]
        http::cleanup $token
        return -code error $err
    }
    set xml [http::data $token]
    array set meta $state(meta)
    http::cleanup $token

    # Do we need to do encoding conversions or was it already done
    # in transit?
 
    if {[info exist meta(Content-Type)] && \
            [regexp -nocase {charset\s*=\s*(\S+)} $meta(Content-Type)]} {
 
        # Socket channel encodings already performed!  No Work to do
        # here.  See section 5.2.2 of the html spec.  Server set
        # encodings win.
 
    } else {
 
        # Read and perform charset mappings of the document rather than
        # hand off the literal string to [dom parse] as Tcl itself is
        # more encoding capable.
 
        set xml [encoding convertfrom [getXmlEncoding $xml] $xml]
    }
 
    # Strip the XML declaration, should it exist.  The encoding
    # conversions have already been performed.  Let's not let Expat
    # try to convert it a second time as the work has already been
    # performed.  As the parser assumes utf-8 by default without a
    # declaration, and the fact that tdom is handing expat the utf-8
    # string rep, this will work even though it doesn't look correct.
 
    return [dom parse -baseurl [uriBase $uri] [stripXmlDecl $xml]]
 }
 
 proc tmlrss::uriBase {uri} {
    array set info [uri::split $uri]
    set info(path) [file dirname $info(path)]
    return [eval uri::join [array get info]]
 }
 
 proc tmlrss::stripXmlDecl {xml} {
    if {![binary scan [string range $xml 0 3] "H8" firstBytes]} {
        # very short (< 4 Bytes) string
        return $xml
    }
 
    # If the entity has an XML Declaration, the first four characters
    # must be "<?xm".
    switch $firstBytes {
        "3c3f786d" {
            # Try to find the end of the XML Declaration
            set closeIndex [string first ">" $xml]
            if {$closeIndex == -1} {
                error "Weird XML data or not XML data at all"
            }
            set xml [string range $xml [expr {$closeIndex+1}] end]
        }
        default {
            # no declaration.
        }
    }
    return $xml
 }
 
 proc tmlrss::getXmlEncoding {xml} {
 
    # The autodetection of the encoding follows
    # XML Recomendation, Appendix F

    if {![binary scan $xml "H8" firstBytes]} {
        # very short (< 4 Bytes) file
         return iso8859-1
    }
    
    # If the entity has a XML Declaration, the first four characters
    # must be "<?xm".
    switch $firstBytes {
        "3c3f786d" {
            # UTF-8, ISO 646, ASCII, some part of ISO 8859, Shift-JIS,
            # EUC, or any other 7-bit, 8-bit, or mixed-width encoding which 
            # ensures that the characters of ASCII have their normal positions,
            # width and values; the actual encoding declaration must be read to
            # detect which of these applies, but since all of these encodings
            # use the same bit patterns for the ASCII characters, the encoding
            # declaration itself can be read reliably.

            # Try to find the end of the XML Declaration
            set closeIndex [string first ">" $xml]
            if {$closeIndex == -1} {
                error "Weird XML data or not XML data at all"
            }
 
            set xmlDeclaration [string range $xml 0 [expr {$closeIndex}]]
            # extract the encoding information
            set pattern {^[^>]+encoding=[\x20\x9\xd\xa]*["']([^ "']+)['"]}
            # emacs: "
            if {![regexp $pattern $xml - encStr]} {
                # Probably something like <?xml version="1.0"?>. 
                # Without encoding declaration, pass-thru
                return iso8859-1
            } else {
                set encoding [tDOM::IANAEncoding2TclEncoding $encStr]
            }
        }
        default {
            # pass-thru
            set encoding iso8859-1
        }
    }
    return $encoding
 }