Posted to tcl by mjanssen at Thu May 28 11:12:48 GMT 2020view raw

  1. namespace eval router {
  2. variable debug false
  3.  
  4. proc route {routes req} {
  5. variable debug
  6. #
  7. # inject params in the request dict and call the command prefix as
  8. set path [dict get $req path]
  9. foreach {route prefixcmd} $routes {
  10. set vars [lassign [Match $route $path] match]
  11. if {$match} {
  12. if {$debug} {
  13. puts "Matched $path with $route"
  14. }
  15. foreach {name val} $vars {
  16. dict lappend req params $name $val
  17. }
  18. if {[string index $prefixcmd 0] ne "!"} {
  19. return [{*}$prefixcmd $req]
  20. } else {
  21. return [{*}[string range $prefixcmd 1 end]]
  22. }
  23.  
  24. }
  25. }
  26. error "No matching route for [dict get $req path]"
  27. }
  28.  
  29.  
  30.  
  31. proc Match {route path} {
  32. set parts [split $route /]
  33. set vars {}
  34. set regexp {}
  35. foreach part $parts {
  36. switch -glob $part {
  37. :* {
  38. lappend vars [string range $part 1 end]
  39. lappend regexp {([^/]+)}
  40. }
  41. @* {
  42. lappend vars [string range $part 1 end]
  43. lappend regexp {(.+)}
  44. }
  45. * {
  46. lappend regexp $part
  47. }
  48.  
  49. }
  50. }
  51. set result {}
  52. if {[regexp ^[join $regexp /]\$ $path -> {*}$vars]} {
  53. lappend result 1
  54. foreach var $vars {
  55. lappend result $var [set $var]
  56. }
  57. } else {
  58. lappend result 0
  59. }
  60. return $result
  61. }
  62. }
  63.  
  64.