File Coverage

blib/lib/Mojo/Cookie/Response.pm
Criterion Covered Total %
statement 39 39 100.0
branch 28 28 100.0
condition 15 16 93.7
subroutine 5 5 100.0
pod 2 2 100.0
total 89 90 98.8


line stmt bran cond sub pod time code
1             package Mojo::Cookie::Response;
2 58     58   67598 use Mojo::Base 'Mojo::Cookie';
  58         143  
  58         445  
3              
4 58     58   25065 use Mojo::Date;
  58         164  
  58         534  
5 58     58   429 use Mojo::Util qw(quote split_cookie_header);
  58         138  
  58         36689  
6              
7             has [qw(domain expires host_only httponly max_age path samesite secure)];
8              
9             my %ATTRS = map { $_ => 1 } qw(domain expires httponly max-age path samesite secure);
10              
11             sub parse {
12 988     988 1 40308 my ($self, $str) = @_;
13              
14 988         1599 my @cookies;
15 988   100     5173 my $tree = split_cookie_header $str // '';
16 988         3500 while (my $pairs = shift @$tree) {
17 190         503 my ($name, $value) = splice @$pairs, 0, 2;
18 190   50     780 push @cookies, $self->new(name => $name, value => $value // '');
19              
20 190         740 while (my ($name, $value) = splice @$pairs, 0, 2) {
21 375 100       1041 next unless $ATTRS{my $attr = lc $name};
22 372 100 100     893 $value =~ s/^\.// if $attr eq 'domain' && defined $value;
23 372 100 100     966 $value = Mojo::Date->new($value // '')->epoch if $attr eq 'expires';
24 372 100 100     1339 $value = 1 if $attr eq 'secure' || $attr eq 'httponly';
25 372 100       1874 $cookies[-1]{$attr eq 'max-age' ? 'max_age' : $attr} = $value;
26             }
27             }
28              
29 988         5317 return \@cookies;
30             }
31              
32             sub to_string {
33 155     155 1 280 my $self = shift;
34              
35             # Name and value
36 155 100 100     433 return '' unless length(my $name = $self->name // '');
37 154   100     442 my $value = $self->value // '';
38 154 100       1041 my $cookie = join '=', $name, $value =~ /[,;" ]/ ? quote $value : $value;
39              
40             # "expires"
41 154         423 my $expires = $self->expires;
42 154 100       569 $cookie .= '; expires=' . Mojo::Date->new($expires) if defined $expires;
43              
44             # "domain"
45 154 100       510 if (my $domain = $self->domain) { $cookie .= "; domain=$domain" }
  24         76  
46              
47             # "path"
48 154 100       361 if (my $path = $self->path) { $cookie .= "; path=$path" }
  74         198  
49              
50             # "secure"
51 154 100       400 $cookie .= "; secure" if $self->secure;
52              
53             # "HttpOnly"
54 154 100       411 $cookie .= "; HttpOnly" if $self->httponly;
55              
56             # "Same-Site"
57 154 100       401 if (my $samesite = $self->samesite) { $cookie .= "; SameSite=$samesite" }
  32         89  
58              
59             # "Max-Age"
60 154 100       346 if (defined(my $max = $self->max_age)) { $cookie .= "; Max-Age=$max" }
  10         25  
61              
62 154         913 return $cookie;
63             }
64              
65             1;
66              
67             =encoding utf8
68              
69             =head1 NAME
70              
71             Mojo::Cookie::Response - HTTP response cookie
72              
73             =head1 SYNOPSIS
74              
75             use Mojo::Cookie::Response;
76              
77             my $cookie = Mojo::Cookie::Response->new;
78             $cookie->name('foo');
79             $cookie->value('bar');
80             say "$cookie";
81              
82             =head1 DESCRIPTION
83              
84             L is a container for HTTP response cookies, based on L
85             6265|https://tools.ietf.org/html/rfc6265>.
86              
87             =head1 ATTRIBUTES
88              
89             L inherits all attributes from L and implements the following new ones.
90              
91             =head2 domain
92              
93             my $domain = $cookie->domain;
94             $cookie = $cookie->domain('localhost');
95              
96             Cookie domain.
97              
98             =head2 expires
99              
100             my $expires = $cookie->expires;
101             $cookie = $cookie->expires(time + 60);
102              
103             Expiration for cookie.
104              
105             =head2 host_only
106              
107             my $bool = $cookie->host_only;
108             $cookie = $cookie->host_only($bool);
109              
110             Host-only flag, indicating that the canonicalized request-host is identical to the cookie's L.
111              
112             =head2 httponly
113              
114             my $bool = $cookie->httponly;
115             $cookie = $cookie->httponly($bool);
116              
117             HttpOnly flag, which can prevent client-side scripts from accessing this cookie.
118              
119             =head2 max_age
120              
121             my $max_age = $cookie->max_age;
122             $cookie = $cookie->max_age(60);
123              
124             Max age for cookie.
125              
126             =head2 path
127              
128             my $path = $cookie->path;
129             $cookie = $cookie->path('/test');
130              
131             Cookie path.
132              
133             =head2 samesite
134              
135             my $samesite = $cookie->samesite;
136             $cookie = $cookie->samesite('Lax');
137              
138             SameSite value. Note that this attribute is B because even though most commonly used browsers support the
139             feature, there is no specification yet besides L
140             draft|https://tools.ietf.org/html/draft-west-first-party-cookies-07>.
141              
142             =head2 secure
143              
144             my $bool = $cookie->secure;
145             $cookie = $cookie->secure($bool);
146              
147             Secure flag, which instructs browsers to only send this cookie over HTTPS connections.
148              
149             =head1 METHODS
150              
151             L inherits all methods from L and implements the following new ones.
152              
153             =head2 parse
154              
155             my $cookies = Mojo::Cookie::Response->parse('f=b; path=/');
156              
157             Parse cookies.
158              
159             =head2 to_string
160              
161             my $str = $cookie->to_string;
162              
163             Render cookie.
164              
165             =head1 SEE ALSO
166              
167             L, L, L.
168              
169             =cut