package CGI::CookieTool;
# $Id: CookieTool.pm,v 1.18 2000/12/17 20:18:00 tom Exp $
################################################################
use strict;
use Exporter;

use vars qw(@ISA @EXPORT);

@ISA = qw(Exporter);
@EXPORT = qw(GetCookie AsCookieHeader);

use DateTime::Time;
use CGI::Tools;
use CGI::QueryString;

my %Cookies;
my %Number;
my $Loaded;

$Loaded = 0;


################################################################

=head2 Reload()

再度 $ENV{'HTTP_COOKIE'}, $ENV{'COOKIE'} から
クッキーを読み取り、データ配列にセットする

=cut

sub Reload()
{
    return if $Loaded;
    &CGI::QueryString::ParseQuery();
    
    %Cookies = ();
    my $raw_cookie = $ENV{'HTTP_COOKIE'} || $ENV{'COOKIE'} || "";
    if ($raw_cookie){
	for (split("; ", $raw_cookie)){
	    my ($key, $value) = split("=");
	    $Cookies{$key} ||= UrlDecode($value);
	    $Number{$key}++;
	}
    }
    $Loaded = 1;
}
################################################################

=head2 GetCookie($name)

$name というクッキーの値を取り出す

=cut

sub GetCookie($)
{
    my $name = shift;
    Reload();
    return $Cookies{$name};
}

sub GetNumberOfCookie($)
{
    my $name = shift;
    Reload();
    return $Number{$name};
}


=head2 AsCookieHeader($name, $value, $expires, $as_meta, $path)

指定したクッキーを HTTP ヘッダとして整形する

$as_meta = 1 だと <meta http-equiv...> 形式で返す。
それ以外は Set-Cookie: 

=cut

sub AsCookieHeader($$;$$$)
{
    my ($name, $value, $expires, $as_meta, $path) = @_;

    # パス部を切り出し（多分合ってる:hns からひっぱってきた）
    unless (defined $path){
	$path = $ENV{'SCRIPT_NAME'};
	$path =~s!/?[^/]+$!!;
    }
    $path = "path=$path;";

    # expires
    require DateTime::Format;
    if ($expires){
	$expires = sprintf("expires=%s"
			 ,DateTime::Format::time2str("%A, %d-%b-%Y %H:%M:%S %Z",
				    (expire_calc($expires)), "GMT"));
    }
    unless ($as_meta){
	return sprintf("Set-Cookie: %s=%s; %s %s\r\n",
		       $name, UrlEncode($value), $path,
		       $expires);
    } else {
	return sprintf(qq(<meta http-equiv="set-cookie" content="%s=%s; %s %s">\n),
		       $name, UrlEncode($value), $path,
		       $expires);
    }
}

################################################################
# thanks to CGI.pm :-)
sub expire_calc {
    my($time) = @_;
    my(%mult) = ('s'=>1,
                 'm'=>60,
                 'h'=>60*60,
                 'd'=>60*60*24,
                 'M'=>60*60*24*30,
                 'y'=>60*60*24*365);
    # format for time can be in any of the forms...
    # "now" -- expire immediately
    # "+180s" -- in 180 seconds
    # "+2m" -- in 2 minutes
    # "+12h" -- in 12 hours
    # "+1d"  -- in 1 day
    # "+3M"  -- in 3 months
    # "+2y"  -- in 2 years
    # "-3m"  -- 3 minutes ago(!)
    # If you don't supply one of these forms, we assume you are
    # specifying the date yourself
    my($offset);
    if (!$time || ($time eq 'now')) {
        $offset = 0;
    } elsif ($time=~/^([+-]?\d+)([mhdMy]?)/) {
        $offset = ($mult{$2} || 1)*$1;
    } else {
        return $time;
    }
    return (time+$offset);
}

1;


