Re: Accept-Header parser

[Harald Oehlmann <ha...@elmicron.de>]

Am 28.03.2012 11:18, schrieb Harald Oehlmann:
> to react on accept-headers, one must:
> - parse the request header to a tcl-friendly format, e.g. a list.
> Is there any code available ?
> 
> I would write a function like:
> 
> # headers(Accept-Language) = de-de,de;q=0.8,en-us;q=0.5,en;q=0.3
> 
> % accept_list $headers(Accept-Language)
> de-de de en-us en *
> 
> The result is ordered by the q element.
> The * signifies that there was no "*;q=0.0" and thus any others are
> implicitly allowed.

There was no answer to the upper post.
Well - here is my proposed function:
<code>
proc ::rivet::accept_list {headerIn} {
	set lqValues {}
	set lItems {}
	foreach itemCur [split $headerIn ,] {
		# 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 {$qCur == 0} {
			if {$itemCur in {"*" "*/*" "*-*"}} {
				set fNoDefault 1
			}
		} else {
			lappend lqValues $qCur
			lappend lItems $itemCur
		}
	}
	set lOut {}
	foreach indexCur [lsort -real -decreasing -indices $lqValues] {
		lappend lOut [lindex $lItems $indexCur]
	}
	if {![info exists fNoDefault]} {
		lappend lOut "*"
	}
	return $lOut
}
</code>

---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-dev-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-dev-help@tcl.apache.org