Posted to tcl by mjanssen at Thu May 28 11:12:48 GMT 2020view pretty
namespace eval router { variable debug false proc route {routes req} { variable debug # # inject params in the request dict and call the command prefix as set path [dict get $req path] foreach {route prefixcmd} $routes { set vars [lassign [Match $route $path] match] if {$match} { if {$debug} { puts "Matched $path with $route" } foreach {name val} $vars { dict lappend req params $name $val } if {[string index $prefixcmd 0] ne "!"} { return [{*}$prefixcmd $req] } else { return [{*}[string range $prefixcmd 1 end]] } } } error "No matching route for [dict get $req path]" } proc Match {route path} { set parts [split $route /] set vars {} set regexp {} foreach part $parts { switch -glob $part { :* { lappend vars [string range $part 1 end] lappend regexp {([^/]+)} } @* { lappend vars [string range $part 1 end] lappend regexp {(.+)} } * { lappend regexp $part } } } set result {} if {[regexp ^[join $regexp /]\$ $path -> {*}$vars]} { lappend result 1 foreach var $vars { lappend result $var [set $var] } } else { lappend result 0 } return $result } }