BigNoseBird.Com- home Small Logo
The 508 compliant Guide to 
       Big Nose Bird
RETURN TO THE NOTEBOOK INDEX

 
Routines for Managing Cookies

with example CGI scripts

These cookie management routines differ from the usual textbook examples in that the expires which usually takes the form of:

expires='Thu, 01-01-2000 15:00:00 GMT';
Is written to the browser as:
expires=Thu 01-01-2000 15:00:00 GMT;
Disposing of the apostrophes and the comma after the day of week, seems to correct the problem of IE 4.0 not expiring the cookie.
#-------------------EXAMPLE OF SETTING A COOKIE---------------------------
#!/usr/bin/perl

require "/usr/local/apache/cgi-bin/cookie.pl";

   $cookie=&set_cookie("login","testuser",0,"/","www.domain.com");

print "$cookie\n";

print "Content-type: text/html\n\n";
print "Have we a cookie?????\n";


#-------------------EXAMPLE OF GETTING A VALUE FROM A COOKIE--------------
#!/usr/bin/perl

require "/usr/local/apache/cgi-bin/cookie.pl";

   print "Content-type: text/html\n\n";

   $cookie=&get_cookie("login");

   if ($cookie ne "")
    {
     print "you have been authenticated as $cookie\n";
    }
   else
    {
     print "Somebody toss me a freakin' cookie....";
    }
  

#-------------------EXAMPLE OF REMOVING A COOKIE--------------------------
#!/usr/bin/perl

require "/usr/local/apache/cgi-bin/cookie.pl";

   $cookie=&remove_cookie("login","/","www.domain.com");

print "$cookie\n";

print "Content-type: text/html\n\n";
print "Have we removed a cookie?????\n";



#-------------------ROUTINE FILE STARTS HERE------------------------------
#
# This routine takes (name,value,minutes_to_live,path,domain) as arguments
# to set a cookie.
#
# 0 minutes means a current browser session cookie life
#
sub set_cookie() {

  my ($name,$value,$expires,$path,$domain) = @_;

  $name=&cookie_scrub($name);
  $value=&cookie_scrub($value);

  $expires=$expires * 60;

  my $expire_at=&cookie_date($expires);
  my $namevalue="$name=$value";

  my $COOKIE="";

  if ($expires != 0) {
     $COOKIE= "Set-Cookie: $namevalue; expires=$expire_at; ";
  }
   else {
     $COOKIE= "Set-Cookie: $namevalue; ";   #current session cookie if 0
   }
  if ($path ne ""){
     $COOKIE .= "path=$path; ";
  }
  if ($domain ne ""){
     $COOKIE .= "domain=$domain; ";
  }
   

  return $COOKIE;
}

#
# This routine removes cookie of (name) by setting the expiration
# to a date/time GMT of (now - 24hours)
#
sub remove_cookie() {

  my ($name,$path,$domain) = @_;

  $name=&cookie_scrub($name);
  my $value="";
  my $expire_at=&cookie_date(-86400);
  my $namevalue="$name=$value";

  my $COOKIE= "Set-Cookie: $namevalue; expires=$expire_at; ";
  if ($path ne ""){
     $COOKIE .= "path=$path; ";
  }
  if ($domain ne ""){
     $COOKIE .= "domain=$domain; ";
  }

  return $COOKIE;
}


#
# given a cookie name, this routine returns the value component
# of the name=value pair
#
sub get_cookie() {

  my ($name) = @_;

  $name=&cookie_scrub($name);
  my $temp=$ENV{'HTTP_COOKIE'};
  @pairs=split(/\; /,$temp);
  foreach my $sets (@pairs) {
    my ($key,$value)=split(/=/,$sets);
    $clist{$key} = $value;
  }
  my $retval=$clist{$name};

  return $retval;
}

#
# this routine accepts the number of seconds to add to the server
# time to calculate the expiration string for the cookie. Cookie
# time is ALWAYS GMT!
#
sub cookie_date() {

  my ($seconds) = @_;

  my %mn = ('Jan','01', 'Feb','02', 'Mar','03', 'Apr','04',
            'May','05', 'Jun','06', 'Jul','07', 'Aug','08',
            'Sep','09', 'Oct','10', 'Nov','11', 'Dec','12' );
  my $sydate=gmtime(time+$seconds);
  my ($day, $month, $num, $time, $year) = split(/\s+/,$sydate);
  my    $zl=length($num);
  if ($zl == 1) { 
    $num = "0$num";
  }

  my $retdate="$day $num-$month-$year $time GMT";

  return $retdate;
}


#
# don't allow = or ; as valid elements of name or data
#
sub cookie_scrub() {

  my($retval) = @_;

  $retval=~s/\;//;
  $retval=~s/\=//;

  return $retval;
}


# usual kluge so require does not fail....

     my $XyZ=1;

#-------------------ROUTINE FILE ENDS HERE--------------------------------



Find or Give Help on the BBS
 
Home Top E-Mail
If it looks great, it's by Christine
Some Fine Print
© 1997-2003 BigNoseBird.Com®, Inc. All rights reserved. All other trademarks are the sole property of their respective owners. The products that we recommend are only ones that we use. We have no relationship with any of the authors or their companies. We cannot assume responsibility for their ultimate performance or lack of same. We also cannot assume responsibility for either any programs provided here, or for any advice that is given since we have no control over what happens after our code or words leave this site. Always use prudent judgment in implementing any program- and always make a backup first! For further information, please read our Privacy Statement. We can be contacted at webmaster@bignosebird.com.


<reallybig.com>
Web Builder Network Portal
Advertise
on the
Reallybig.com
Network
BigNoseBird Newsletter
Subscribe
Un-Subscribe


Sign up today to receive our low volume newsletter. Tips, tricks, news, and whatever else crosses our minds.
Back Issues
Privacy Statement