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

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)"
	}
    }
}