Hi everyone
About a month ago Harald proposed a script to parse 'Accept' HTTP header
lines. He has written a larger and more complete version of
his ::rivet::accept_list procedure which was given the temporary
name ::rivet::http_accept2dict. Here is the code. Comments and proposals
are welcome (my proposal is to name it ::rivet::http_accept
or ::rivet::http_parse_accept or ::rivet::parse_accept)
I propose also to add a -list switch which could easily emulate
the ::rivet::accept_list procedure Harald had posted on this list in
April.
if no one objects I will commit it
-- Massimo
proc ::rivet::http_accept2dict {args} {
set lqValues {}
set lItems {}
# parameter
while { [llength $args] > 1 } {
set args [lassign $args argCur]
switch -exact -- $argCur {
-zeroweight { set fZeroWeight 1 }
-default { set fDefault 1 }
-- {}
default { return -code error "Unknown argument '$argCur'" }
}
}
# loop over comma-separated items
foreach itemCur [split [lindex $args 0] ,] {
# Find q value as last element separated by ;
set qCur 1
if {[regexp {^(.*); *q=([^;]*)$} $itemCur match itemCur
qString]} {
if { 1 == [scan $qString %f qVal] && $qVal >= 0 && $qVal <=
1 } {
set qCur $qVal
}
}
set itemCur [string trim $itemCur]
if { $itemCur in {"*" "*/*" "*-*"} } {
unsetset -nocomplain fDefault
}
if { [info exists fZeroWeight] || $qCur > 0 } {
lappend lqValues $qCur
lappend lItems $itemCur
}
}
# build output dict in decreasing q order
set dOut {}
foreach indexCur [lsort -real -decreasing -indices $lqValues] {
set qCur [lindex $lqValues $indexCur]
if {$qCur == 0 && [info exists fDefault]} {
dict set dOut * 0.01
unset fDefault
}
dict set dOut [lindex $lItems $indexCur] $qCur
}
if { [info exists fDefault] } {
dict set dOut * 0.01
}
return $dOut
}
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-dev-unsubscr...@tcl.apache.org
For additional commands, e-mail: rivet-dev-h...@tcl.apache.org
