Mercurial > hg > egg-tcls

comparison utillib.tcl @ 658:33580ee2579e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
utillib: Add helper functions utl_http_do_request() and utl_http_clear_request().
author Matti Hamalainen <ccr@tnsp.org>
date Fri, 19 Feb 2021 21:02:53 +0200
parents c340683d6c13
children 586caf75fccc
comparison
equal deleted inserted replaced
657:f46c152183a2 658:33580ee2579e
19 append utl_html_ent_str "|&#xa0;| |&pound;|£|&#38;|&|&#158;|ž|&#196;|Ä|&#186;|º" 19 append utl_html_ent_str "|&#xa0;| |&pound;|£|&#38;|&|&#158;|ž|&#196;|Ä|&#186;|º"
20 append utl_html_ent_str "|&#8230;|...|&#47;|/|&#10;| |&#034;|\"|&#x27;|\"" 20 append utl_html_ent_str "|&#8230;|...|&#47;|/|&#10;| |&#034;|\"|&#x27;|\""
21 append utl_html_ent_str "|‘|'|’|'|”|\"|&scaron;|š|&Scaron;|Š|&#37;|%|&#214;|Ö" 21 append utl_html_ent_str "|‘|'|’|'|”|\"|&scaron;|š|&Scaron;|Š|&#37;|%|&#214;|Ö"
22 22
23 set utl_html_ent_list [split [encoding convertfrom "utf-8" $utl_html_ent_str] "|"] 23 set utl_html_ent_list [split [encoding convertfrom "utf-8" $utl_html_ent_str] "|"]
24
25
26 # Convert given string, containing HTML/XML style entities into a normal
27 # UTF-8 Unicode string, using the above entity->character mapping
28 proc utl_convert_html_ent {udata} {
29 global utl_html_ent_list
30 return [string map -nocase $utl_html_ent_list [string map $utl_html_ent_list $udata]]
31 }
32 24
33 25
34 # Split given string "str" into a list of sub-strings of maximum length 26 # Split given string "str" into a list of sub-strings of maximum length
35 # "maxlen", by attempting to split at "words", if possible. 27 # "maxlen", by attempting to split at "words", if possible.
36 proc utl_str_split {str maxlen} { 28 proc utl_str_split {str maxlen} {
153 return 1 145 return 1
154 } 146 }
155 147
156 148
157 ### 149 ###
150 ### HTML / HTTP related
151 ###
152 # Convert given string, containing HTML/XML style entities into a normal
153 # UTF-8 Unicode string, using the above entity->character mapping
154 proc utl_convert_html_ent {udata} {
155 global utl_html_ent_list
156 return [string map -nocase $utl_html_ent_list [string map $utl_html_ent_list $udata]]
157 }
158
159
160 proc utl_http_clear_request { urlStatus urlSCode urlCode urlData urlMeta } {
161
162 ### Clear the request data
163 upvar $urlStatus ustatus
164 upvar $urlSCode uscode
165 upvar $urlCode ucode
166 upvar $urlData udata
167 upvar $urlMeta umeta
168
169 unset ustatus
170 unset uscode
171 unset ucode
172 unset udata
173 array unset umeta
174 }
175
176
177 proc utl_http_do_request { urlHeaders urlStr urlStatus urlSCode urlCode urlData urlMeta } {
178
179 upvar $urlStatus ustatus
180 upvar $urlSCode uscode
181 upvar $urlCode ucode
182 upvar $urlData udata
183 upvar $urlMeta umeta
184
185 #set urlHeaders {}
186 #lappend urlHeaders "Accept-Encoding" "identity"
187 #lappend urlHeaders "Connection" "keep-alive"
188
189 ### Perform request
190 if {[catch {set utoken [::http::geturl $urlStr -timeout 6000 -binary 1 -headers $urlHeaders]} uerror]} {
191 set uscode $uerror
192 return -1
193 }
194
195 ### Check status
196 set ustatus [::http::status $utoken]
197 set uscode [::http::code $utoken]
198 set ucode [::http::ncode $utoken]
199
200 if {$ustatus != "ok"} {
201 return -2
202 }
203
204 ### Get data
205 set udata [::http::data $utoken]
206 array set umeta [::http::meta $utoken]
207 ::http::cleanup $utoken
208
209 ### Sanitize the metadata KEYS
210 foreach {ukey uvalue} [array get umeta] {
211 set ukey [string tolower $ukey]
212 set umeta($ukey) $uvalue
213 }
214
215 return 0
216 }
217
218
219 ###
158 ### SQL database handling 220 ### SQL database handling
159 ### 221 ###
160 proc utl_sql_init {ndb_handle db_type db_name db_host db_port db_user db_pass} { 222 proc utl_sql_init {ndb_handle db_type db_name db_host db_port db_user db_pass} {
161 upvar $ndb_handle udb_handle 223 upvar $ndb_handle udb_handle
162 224