... #### Method: cookie # Set or read a cookie from the specified name. # Cookie can then be passed to header(). # Usual rules apply to the stickiness of -value. # Parameters: # -name -> name for this cookie (optional) # -value -> value of this cookie (scalar, array or hash) # -path -> paths for which this cookie is valid (optional) # -domain -> internet domain in which this cookie is valid (optional) # -secure -> if true, cookie only passed through secure channel (optional) # -expires -> expiry date in format Wdy, DD-Mon-YYYY HH:MM:SS GMT (optional) #### sub cookie { my($self,@p) = self_or_default(@_); my($name,$value,$path,$domain,$secure,$expires,$httponly,$max_age,$samesite) = rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY,'MAX-AGE',SAMESITE],@p); require CGI::Cookie; # if no value is supplied, then we retrieve the # value of the cookie, if any. For efficiency, we cache the parsed # cookies in our state variables. unless ( defined($value) ) { $self->{'.cookies'} = CGI::Cookie->fetch; # If no name is supplied, then retrieve the names of all our cookies. return () unless $self->{'.cookies'}; return keys %{$self->{'.cookies'}} unless $name; return () unless $self->{'.cookies'}->{$name}; return $self->{'.cookies'}->{$name}->value if defined($name) && $name ne ''; } # If we get here, we're creating a new cookie return undef unless defined($name) && $name ne ''; # this is an error my @param; push(@param,'-name'=>$name); push(@param,'-value'=>$value); push(@param,'-domain'=>$domain) if $domain; push(@param,'-path'=>$path) if $path; push(@param,'-expires'=>$expires) if $expires; push(@param,'-secure'=>$secure) if $secure; push(@param,'-httponly'=>$httponly) if $httponly; push(@param,'-max_age'=>$max_age) if $max_age; push(@param,'-samesite'=>$samesite) if $samesite; return CGI::Cookie->new(@param); } ...