Mercurial > hg > egg-tcls

comparison fetch_feeds.tcl @ 657:f46c152183a2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fetch_feeds: Use generic HTTP request handling code also for RSS feed fetches.
author Matti Hamalainen <ccr@tnsp.org>
date Fri, 19 Feb 2021 19:30:53 +0200
parents 7192d94f8c28
children ab2ba0b82407
comparison
equal deleted inserted replaced
656:7192d94f8c28 657:f46c152183a2
122 } 122 }
123 123
124 124
125 proc add_entry {uname uprefix uurl utitle} { 125 proc add_entry {uname uprefix uurl utitle} {
126 global currclock feeds_db nitems 126 global currclock feeds_db nitems
127
127 set utmp [utl_convert_html_ent $uurl] 128 set utmp [utl_convert_html_ent $uurl]
128 if {[string match "http://*" $utmp] || [string match "https://*" $utmp]} { 129 if {[string match "http://*" $utmp] || [string match "https://*" $utmp]} {
129 set utest "$utmp" 130 set utest "$utmp"
130 } else { 131 } else {
131 if {[string range $uprefix end end] != "/" && [string range $utmp 0 0] != "/"} { 132 if {[string range $uprefix end end] != "/" && [string range $utmp 0 0] != "/"} {
147 } 148 }
148 } 149 }
149 150
150 151
151 proc add_rss_feed {datauri dataname dataprefix} { 152 proc add_rss_feed {datauri dataname dataprefix} {
152 if {[catch {set utoken [::http::geturl $datauri -binary 1 -timeout 6000 -headers {Accept-Encoding identity}]} uerrmsg]} { 153 if {![fetch_dorequest $datauri ustatus uscode ucode upage umeta]} {
153 puts "Error getting $datauri: $uerrmsg" 154 return 0
154 return 1 155 }
155 }
156 set upage [::http::data $utoken]
157 ::http::cleanup $utoken
158 156
159 set umatches [regexp -all -nocase -inline -- "<item>.\*\?<title><..CDATA.(.\*\?)\\\]\\\]></title>.\*\?<link>(http.\*\?)</link>.\*\?</item>" $upage] 157 set umatches [regexp -all -nocase -inline -- "<item>.\*\?<title><..CDATA.(.\*\?)\\\]\\\]></title>.\*\?<link>(http.\*\?)</link>.\*\?</item>" $upage]
160 set nmatches [llength $umatches] 158 set nmatches [llength $umatches]
161 for {set n 0} {$n < $nmatches} {incr n 3} { 159 for {set n 0} {$n < $nmatches} {incr n 3} {
162 add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]] 160 add_entry $dataname $dataprefix [lindex $umatches [expr $n+2]] [lindex $umatches [expr $n+1]]