#/usr/bin/perl -- -*- C -*- # # Author: John Blanco Jr. # Date: 3/14/97 # Type: Public Domain # # Description: For use with the Perl Language. Enables easy use of # Netscape's Magic Cookie implementation. # (Currently supported by at least Netscape and IE) # # Fixed a bug in GetCookie - Ram (me@ram.org) # # Initiate your CGI w/Cookie header. sub BeginCookieHeader { return "Content-type: text/html\n"; } # Creates a cookie for the client's browser to store # Note: Leaving out an expiration will keep the cookie alive until the # user shuts down the browser. sub MakeCookie { # Summon variable/value/expiration values $variable = shift(_); $value = shift(_); $expires = shift(_); if ($value) { # Format the expiration date if ($expires) { $expires = "; expires=" . $expires; } return "Set-cookie: $variable=${value}; path=/; $expires\n"; } # return; } # Terminate your CGI w/Cookie header. sub EndCookieHeader { return "\n"; } # Searches for a cookie from the client based on a variable. # This can be called anywhere in any CGI script! sub GetCookie { # Summon variable we are looking for $variable = shift(_); # Check for cookie(s) $http_cookie = $ENV{'HTTP_COOKIE'}; # print "

$http_cookie

\n"; # If cookie, then look for variable, else return unsuccessful $value = ""; if ($http_cookie) { # Seperate our cookies @allcookies = split(/;/, $http_cookie); # Check through all cookies for the matching variable name foreach $cookie (@allcookies) { # print "

---> $cookie

\n"; # If we find the right cookie, save it # if ($http_cookie =~ /$variable=(\S+)/) if ($cookie =~ /$variable=(.+)/) { $value = $1; last; } } } else { $value = ""; } # Return the cookie value or a null string return $value; } 1; #return true