Posted to tcl by colin at Fri Sep 06 01:38:52 GMT 2013view raw

  1. if {0} {
  2. Debug on httpd
  3. Debug on httpdlow
  4. Debug on cookies
  5. Nub code /noncookie/ {
  6. set r [Http NoCache $r]
  7. set cdict [dict get? $r -cookies]
  8. if {[catch {Cookies fetch $cdict -name cookie} cl]} {
  9. return [Http Ok [<p> "No Cookies for YOU"]]
  10. } else {
  11. return [Http Ok [<p> "Got cookies! $cl"]]
  12. }
  13. }
  14.  
  15. Nub code /cookie/set {
  16. set r [Http NoCache $r]
  17.  
  18. # add in the cookies
  19. set cdict [dict get? $r -cookies]
  20. set cdict [Cookies add $cdict -path /cookie/ -name cookie -value cookie]
  21. set cdict [Cookies add $cdict -path /cookie/set/ -name cookie -value set]
  22. set cdict [Cookies add $cdict -path /cookie/test/ -name cookie -value test]
  23. set cdict [Cookies add $cdict -path /noncookie/ -name cookie -value noncookie]
  24. set cdict [Cookies add $cdict -name cookie -value nopath]
  25. dict set r -cookies $cdict
  26.  
  27. <p> "Set you some Cookies"
  28. }
  29.  
  30. Nub code /cookie/ {
  31. set cdict [dict get? $r -cookies]
  32.  
  33. set result [dict get? $r -content]
  34. if {[catch {Cookies fetch $cdict -name cookie} cl]} {
  35. append result \n [<p> "No Cookies for YOU"]
  36. } else {
  37. append result \n [<p> "Got cookies! $cl ($cdict)"]
  38. }
  39. set result
  40. }
  41.  
  42. Nub code /cookie/test {
  43. set r [Http NoCache $r]
  44. set cdict [dict get? $r -cookies]
  45. if {[catch {Cookies fetch $cdict -name cookie} cl]} {
  46. <p> "No Cookies for YOU"
  47. } else {
  48. <p> "Got cookies! $cl ($cdict)"
  49. }
  50. }
  51.  
  52. Nub code /cookie/clear {
  53. set r [Http NoCache $r]
  54. set cdict [dict get? $r -cookies]
  55. if {[catch {Cookies fetch $cdict -name cookie} cl]} {
  56. <p> "No Cookies for YOU"
  57. } else {
  58. set r [Cookies Clear $r -name cookie]
  59. <p> "Clearing cookies! $cl ($cdict)"
  60. }
  61. }
  62. }