Posted to tcl by avl at Fri Jun 16 20:59:50 GMT 2017view raw

  1. proc t srvurl {
  2. set validityRE {(?xi)
  3. ^
  4. # Path part (already must start with / character)
  5. (?: [-\w.~!$&'()*+,;=:@/] | %[0-9a-f][0-9a-f] )*
  6. # Query part (optional, permits ? characters)
  7. (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?
  8. $
  9. }
  10. if {![regexp -- $validityRE $srvurl]} {
  11. # Provide a better error message in this error case
  12. if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
  13. puts stdout "Yes!! That is it!!"
  14. }
  15. puts stdout error "No, try again. :("
  16. }
  17. }
  18. % t http://foo.bar/snafu?%##
  19. Yes!! That is it!!
  20. wrong # args: should be "puts ?-nonewline? ?channelId? string"
  21. % t /snafu?%##
  22. Yes!! That is it!!
  23. wrong # args: should be "puts ?-nonewline? ?channelId? string"
  24. % t ?%##
  25. Yes!! That is it!!
  26. wrong # args: should be "puts ?-nonewline? ?channelId? string"
  27. % t %##
  28. Yes!! That is it!!
  29. wrong # args: should be "puts ?-nonewline? ?channelId? string"
  30.