File Coverage

blib/lib/Servlet/Http/Cookie.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# -*- Mode: Perl; indent-tabs-mode: nil; -*-

package Servlet::Http::Cookie;

use fields qw(name value comment domain maxage path secure version);
use strict;
use warnings;

use Servlet::Util::Exception ();

my $Fieldpat = '(comment|discard|domain|expires|max\-age|path|secure|version)';

sub new {
    my $self = shift;
    my $name = shift;
    my $value = shift;

    unless ($name) {
        my $msg = 'cookie name needed';
        Servlet::Util::IllegalArgumentException->throw($msg);
    }

    if ($name !~ /^[[:alpha:]]+$/ ||
        $name =~ /,;\s/ ||
        $name =~ /^\$/ ||
        $name =~ /$Fieldpat/i) {
        my $msg = "invalid cookie name [$name]";
        Servlet::Util::IllegalArgumentException->throw($msg);
    }

    $self = fields::new($self) unless ref $self;

    $self->{name} = $name;
    $self->{value} = $value;
    $self->{comment} = undef;
    $self->{domain} = undef;
    $self->{maxage} = -1;
    $self->{path} = undef;
    $self->{secure} = undef;
    $self->{version} = 0;

    return $self;
}

sub getComment {
    my $self = shift;

    return $self->{comment};
}

sub getDomain {
    my $self = shift;

    return $self->{domain};
}

sub getMaxAge {
    my $self = shift;

    return $self->{maxage};
}

sub getName {
    my $self = shift;

    return $self->{name};
}

sub getPath {
    my $self = shift;

    return $self->{path};
}

sub getSecure {
    my $self = shift;

    return $self->{secure};
}

sub getValue {
    my $self = shift;

    return $self->{value};
}

sub getVersion {
    my $self = shift;

    return $self->{version};
}

sub setComment {
    my $self = shift;
    my $purpose = shift;

    $self->{comment} = $purpose;

    return 1;
}

sub setDomain {
    my $self = shift;
    my $pattern = shift;

    $self->{domain} = lc($pattern); # IE allegedly needs this

    return 1;
}

sub setMaxAge {
    my $self = shift;
    my $expiry = shift;

    $self->{maxage} = $expiry;

    return 1;
}

sub setPath {
    my $self = shift;
    my $uri = shift;

    $self->{path} = $uri;

    return 1;
}

sub setSecure {
    my $self = shift;
    my $flag = shift;

    $self->{secure} = $flag;

    return 1;
}

sub setValue {
    my $self = shift;
    my $newvalue = shift;

    $self->{value} = $newvalue;

    return 1;
}

sub setVersion {
    my $self = shift;
    my $v = shift;

    $self->{version} = $v;

    return 1;
}

1;
__END__