Comparison of the old and new URL matching expressions for @ in URL.

proc match_old {url} {
    set exp {^(([^:]*)://)?([^@]+@)?([^/:]+)(:([0-9]+))?(/.*)?$}
    if {![regexp -nocase $exp $url x prefix proto user host y port srvurl]} {
	return -code error "Unsupported URL: $url"
    }
    return [list $proto $user $host $port $srvurl]
}

proc match_now {url} {
    set URLmatcher {(?x)		# this is _expanded_ syntax
	^
	(?: (\w+) : ) ?			# <protocol scheme>
	(?: //
	    (?:
		(
		    [^@/\#?]+		# <userinfo part of authority>
		) @
	    )?
	    ( [^/:\#?]+ )		# <host part of authority>
	    (?: : (\d+) )?		# <port part of authority>
	)?
	( / [^\#]*)?			# <path> (including query)
	(?: \# (.*) )?			# <fragment>
	$
    }
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
	return -code error "Unsupported URL: $url"
    }
    return [list $proto $user $host $port $srvurl]
}

foreach url {
    http://www.example.com/?iq=1
    http://user:pass@www.example.com/?a=1&b-2
    http://www.example.com/?q=1/2/3/@xyz
    http://user:pass@www.example.com/?q=1/2/3/@xyz
} {
    puts "old: [lindex [match_old $url] 1]"
    puts "new: [lindex [match_now $url] 1]"
}

## results:
pat@frog:/opt/src/tcl.git$ tclsh ../http_check.tcl 
old: 
new: 
old: user:pass@
new: user:pass
old: www.example.com/?q=1/2/3/@
new: 
old: user:pass@
new: user:pass
pat@frog:/opt/src/tcl.git$