Posted to tcl by colin at Fri Sep 06 01:38:52 GMT 2013view raw
- if {0} {
- Debug on httpd
- Debug on httpdlow
- Debug on cookies
- Nub code /noncookie/ {
- set r [Http NoCache $r]
- set cdict [dict get? $r -cookies]
- if {[catch {Cookies fetch $cdict -name cookie} cl]} {
- return [Http Ok [<p> "No Cookies for YOU"]]
- } else {
- return [Http Ok [<p> "Got cookies! $cl"]]
- }
- }
- Nub code /cookie/set {
- set r [Http NoCache $r]
- # add in the cookies
- set cdict [dict get? $r -cookies]
- set cdict [Cookies add $cdict -path /cookie/ -name cookie -value cookie]
- set cdict [Cookies add $cdict -path /cookie/set/ -name cookie -value set]
- set cdict [Cookies add $cdict -path /cookie/test/ -name cookie -value test]
- set cdict [Cookies add $cdict -path /noncookie/ -name cookie -value noncookie]
- set cdict [Cookies add $cdict -name cookie -value nopath]
- dict set r -cookies $cdict
- <p> "Set you some Cookies"
- }
- Nub code /cookie/ {
- set cdict [dict get? $r -cookies]
- set result [dict get? $r -content]
- if {[catch {Cookies fetch $cdict -name cookie} cl]} {
- append result \n [<p> "No Cookies for YOU"]
- } else {
- append result \n [<p> "Got cookies! $cl ($cdict)"]
- }
- set result
- }
- Nub code /cookie/test {
- set r [Http NoCache $r]
- set cdict [dict get? $r -cookies]
- if {[catch {Cookies fetch $cdict -name cookie} cl]} {
- <p> "No Cookies for YOU"
- } else {
- <p> "Got cookies! $cl ($cdict)"
- }
- }
- Nub code /cookie/clear {
- set r [Http NoCache $r]
- set cdict [dict get? $r -cookies]
- if {[catch {Cookies fetch $cdict -name cookie} cl]} {
- <p> "No Cookies for YOU"
- } else {
- set r [Cookies Clear $r -name cookie]
- <p> "Clearing cookies! $cl ($cdict)"
- }
- }
- }