File Coverage

lib/Spoon/Cookie.pm

Criterion	Covered	Total	%
statement	25	43	58.1
branch	6	10	60.0
condition	1	4	25.0
subroutine	6	9	66.6
pod	1	5	20.0
total	39	71	54.9

package Spoon::Cookie;
use Spoon::Base -Base;
use CGI;

field 'preferences';
field 'jar' => {};
field 'jar_opt' => {};
const expires => '+5y';
const path => '/';
const prefix => 'Spoon-';
const domain => '';

sub init {
    $self->fetch();
}

sub write {
    my ($cookie_name, $hash, $opt) = @_;
    require Storable;
    $self->jar->{$cookie_name} = $hash;
    $self->jar_opt->{$cookie_name} = $opt if $opt;
}

sub read {
    my $cookie_name = shift;
    my $jar = $self->jar;
    my $cookie = $jar->{$cookie_name};
    $cookie ||= {};
    return $cookie;
}

sub set_cookie_headers {
    my $jar = $self->jar;
    return () unless keys %$jar;
    my $cookies = [];
    @$cookies = map {
	CGI::cookie(
            -name => $self->prefix . $_,
            -value => Storable::freeze($jar->{$_} || {}),
            -path => $self->path,
            -expires => $self->expires,
            -domain => $self->domain,
            %{$self->jar_opt->{$_} || {}},
        );
    } keys %$jar;
    return @$cookies ? (-cookie => $cookies) : ();
}

sub fetch {
    require Storable;
    my $prefix = $self->prefix;
    my $jar = {
        map {
            (my $key = $_) =~ s/^\Q$prefix\E//;
            my $object = eval { Storable::thaw(CGI::cookie($_)) };
            $@ ? () : ($key => $object)
        }
        grep { /^\Q$prefix\E/ } CGI::cookie()
    };
    $self->jar($jar);
}

__END__