use APR::Table;
use APR::Error;

package Apache::Cookie::Table;
push our(@ISA), "APR::Table";
BEGIN {
    my @BAD_METHODS = qw/compress merge overlap/;
    for (@BAD_METHODS) {
        no strict;
        next unless my $meth = APR::Table->can($_);
        *{$_} = sub {die __PACKAGE__ ."::",  "$_: unsafe operation"};
    }
}

package Apache::Cookie::Error;
push our(@ISA), qw/APR::Error Apache::Cookie/;

package Apache::Cookie::Jar::Error;
push our(@ISA), qw/APR::Error Apache::Cookie::Jar/;

package Apache::Cookie::Jar;

sub new {
    my $class = shift;
    my $env = shift;
    my $jar = $class->jar($env);
    $jar->config(@_) if @_;
    return $jar;
}


package Apache::Cookie;
use overload '""' => sub { shift->as_string };

sub jar {
    my ($self, $env) = @_;
    Apache::Cookie::Jar->jar($env);
}


sub new {
    my ($class, $env, %attrs) = @_;
    my $name  = delete $attrs{name};
    my $value = delete $attrs{value};
    $name     = delete $attrs{-name}  unless defined $name;
    $value    = delete $attrs{-value} unless defined $value;
    return unless defined $name and defined $value;

    my $cookie = $class->make($env, $name, $class->freeze($value));
    $cookie->set_attr(%attrs);
    return $cookie;
}

sub fetch {
    my $class = shift;
    my $env = shift;
    unless (defined $env) {
        my $usage = 'Usage: Apache::Cookie->fetch($r): missing argument $r';

        if ($class->env eq "Apache::RequestRec") { # mp2
            $env = eval {Apache->request} or die <<EOD;
$usage: attempt to fetch global Apache->request failed: $@.
EOD
            # warn $usage;
        }
        else {
            die $usage;
        }
    }
    my $jar = $class->jar($env, @_);
    return wantarray ? %{(scalar $jar->cookies) || {}} : $jar->cookies;
}

sub freeze {
    my ($class, $value) = @_;
    die "Usage: Apache::Cookie->freeze($value)" unless @_ == 2;

    if (not ref $value) {
        return encode($value);
    }
    elsif (UNIVERSAL::isa($value, "ARRAY")) {
        return join '&', map encode($_), @$value;
    }
    elsif (UNIVERSAL::isa($value, "HASH")) {
        return join '&', map encode($_), %$value;
    }

    die "Can't freeze reference: $value";
}

sub thaw {
    my $self = shift;
    my @rv = split /&/, @_ ? shift : $self->raw_value;
    return wantarray ? map decode($_), @rv : decode($rv[0]);
}

sub value { shift->thaw }

