Howdy -

I'm having some trouble deleting a cookie using CGI::Cookie.  Here is the
code I'm using to do this.  Note this is in a module, so I have written
wrappers for the CGI::Cookie Set/Get functionality.  However, this is test
code, so it's being accessed in it's own namespace.  I know that this code
writes cookies.  But, I cannot seem to modify the properties of an existing
cookie.

use strict;
use CGI qw/:standard/;
use CGI::Cookie;

my $name = 'Johnny';
my $cookie = GetCookie($name);

if ($cookie)
    {
    # Set the 'expires' attribute to -1M
    $cookie = DeleteCookie($name);
    # If the cookie object is returned, print its new properties
    if ($cookie)
        {
        print $h_self{cgi}->header(-cookie=>$cookie);

        print qq[Just set the cookie to be deleted.  These are the
properties:<br />];

        print "-name is ". $cookie->name ."<br />";
        print "-value is ". $cookie->value ."<br />";
        print "-expires is ". $cookie->expires ."<br />";
        print "-path is ". $cookie->path ."<br />";
        print "-domain is ". $cookie->domain ."<br />";
        print "-secure is ". $cookie->secure ."<br />";

        print qq[Close the browser and look in the cookies folder<br />];
        }
    # If the cookie was not returned, there was a problem.
    else
        {
        print $h_self{cgi}->header;
        print qq[Something has gone completely wrong here!];
        }
    }

sub GetCookie
    {
    my ($name) = @_;
    my %h_cookies = fetch CGI::Cookie();
    (exists $h_cookies{$name})?return $h_cookies{$name}:return 0;
    }

sub DeleteCookie
    {
    my ($name) = @_;
    # Get the cookie
    my $cookie = GetCookie($name);
    # Set the expiration date to delete cookie
    $cookie = SetCookieProp($name,'expires','-1M');
    ($cookie)?return $cookie:return 0;
    }

sub SetCookieProp
    {
    my ($name, $prop, $value) = @_;
    # Get the cookie
    my $cookie = $hr_self->GetCookie($name);
    # Set the named property to the new value
    $cookie->$prop($value);
    ($cookie)?return $cookie:return 0;
    }


Ron Goral
Up On The Mountain Design Group
Custom solutions for your database driven web site.



-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>


Reply via email to