]> mj.ucw.cz Git - libucw.git/commitdiff
CGI.pm: More improvements to the cookie mechanism.
authorMartin Mares <mj@ucw.cz>
Sat, 13 Sep 2008 15:23:21 +0000 (17:23 +0200)
committerMartin Mares <mj@ucw.cz>
Sat, 13 Sep 2008 15:23:21 +0000 (17:23 +0200)
I am trying to make the parameters as close as possible to the
new standard (they make better sense and I want to keep the function
compatible with older versions of CGI.pm).

It also handles options with no values more gracefully.

ucw/perl/CGI.pm

index 8e4096e69a6f61ef29b3501314464de390a84530..99ab83a9ffc2eb7705b892e7fb5791feeeb5cb48 100644 (file)
@@ -427,13 +427,19 @@ sub set_cookie($$@) {
        #       max-age         maximal age in seconds
        #       domain          domain name scope
        #       path            path name scope
-       #       secure          if non-zero, cookie applies only to SSL connections
+       #       secure          if present, cookie applies only to SSL connections
+       #                       (in this case, the value should be undefined)
+       #       discard         if present with any value, the cookie is discarded
        #
 
        my $key = shift @_;
        my $value = shift @_;
        my %other = @_;
-       if (my $age = $other{'max-age'}) {
+       if (exists $other{'discard'}) {
+               delete $other{'discard'};
+               $other{'max-age'} = 0;
+       }
+       if (defined(my $age = $other{'max-age'})) {
                delete $other{'max-age'};
                my $exp = ($age ? (time + $age) : 0);
                # Avoid problems with locales
@@ -443,14 +449,12 @@ sub set_cookie($$@) {
                $other{'expires'} = sprintf("%s, %02d-%s-%d %02d:%02d:%02d GMT",
                        $wdays[$wd], $d, $mons[$m], $y+1900, $H, $M, $S);
        }
-       my $secure = $other{'secure'};
-       delete $other{'secure'};
 
        print "Set-Cookie: $key=", url_escape($value);
        foreach my $k (keys %other) {
-               print "; $k=", $other{$k};
+               print "; $k";
+               print "=", $other{$k} if defined $other{$k};
        }
-       print "; secure" if $secure;
        print "\n";
 }