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 54     54   65373 use Mojo::Base 'Mojo::Cookie';
  54         127  
  54         353  
3              
4 54     54   22516 use Mojo::Date;
  54         145  
  54         602  
5 54     54   386 use Mojo::Util qw(quote split_cookie_header);
  54         125  
  54         30541  
6              
7             has [qw(domain expires host_only httponly max_age path samesite secure)];
8              
9             my %ATTRS
10             = map { $_ => 1 } qw(domain expires httponly max-age path samesite secure);
11              
12             sub parse {
13 869     869 1 2112 my ($self, $str) = @_;
14              
15 869         1438 my @cookies;
16 869   100     4694 my $tree = split_cookie_header $str // '';
17 869         3243 while (my $pairs = shift @$tree) {
18 184         457 my ($name, $value) = splice @$pairs, 0, 2;
19 184   50     748 push @cookies, $self->new(name => $name, value => $value // '');
20              
21 184         683 while (my ($name, $value) = splice @$pairs, 0, 2) {
22 351 100       908 next unless $ATTRS{my $attr = lc $name};
23 348 100 100     1244 $value =~ s/^\.// if $attr eq 'domain' && defined $value;
24 348 100 100     858 $value = Mojo::Date->new($value // '')->epoch if $attr eq 'expires';
25 348 100 100     1176 $value = 1 if $attr eq 'secure' || $attr eq 'httponly';
26 348 100       1689 $cookies[-1]{$attr eq 'max-age' ? 'max_age' : $attr} = $value;
27             }
28             }
29              
30 869         4661 return \@cookies;
31             }
32              
33             sub to_string {
34 151     151 1 262 my $self = shift;
35              
36             # Name and value
37 151 100 100     391 return '' unless length(my $name = $self->name // '');
38 150   100     413 my $value = $self->value // '';
39 150 100       706 my $cookie = join '=', $name, $value =~ /[,;" ]/ ? quote $value : $value;
40              
41             # "expires"
42 150         393 my $expires = $self->expires;
43 150 100       551 $cookie .= '; expires=' . Mojo::Date->new($expires) if defined $expires;
44              
45             # "domain"
46 150 100       439 if (my $domain = $self->domain) { $cookie .= "; domain=$domain" }
  24         56  
47              
48             # "path"
49 150 100       382 if (my $path = $self->path) { $cookie .= "; path=$path" }
  70         169  
50              
51             # "secure"
52 150 100       419 $cookie .= "; secure" if $self->secure;
53              
54             # "HttpOnly"
55 150 100       345 $cookie .= "; HttpOnly" if $self->httponly;
56              
57             # "Same-Site"
58 150 100       364 if (my $samesite = $self->samesite) { $cookie .= "; SameSite=$samesite" }
  28         82  
59              
60             # "Max-Age"
61 150 100       500 if (defined(my $max = $self->max_age)) { $cookie .= "; Max-Age=$max" }
  10         21  
62              
63 150         750 return $cookie;
64             }
65              
66             1;
67              
68             =encoding utf8
69              
70             =head1 NAME
71              
72             Mojo::Cookie::Response - HTTP response cookie
73              
74             =head1 SYNOPSIS
75              
76             use Mojo::Cookie::Response;
77              
78             my $cookie = Mojo::Cookie::Response->new;
79             $cookie->name('foo');
80             $cookie->value('bar');
81             say "$cookie";
82              
83             =head1 DESCRIPTION
84              
85             L is a container for HTTP response cookies, based on
86             L.
87              
88             =head1 ATTRIBUTES
89              
90             L inherits all attributes from L and
91             implements the following new ones.
92              
93             =head2 domain
94              
95             my $domain = $cookie->domain;
96             $cookie = $cookie->domain('localhost');
97              
98             Cookie domain.
99              
100             =head2 expires
101              
102             my $expires = $cookie->expires;
103             $cookie = $cookie->expires(time + 60);
104              
105             Expiration for cookie.
106              
107             =head2 host_only
108              
109             my $bool = $cookie->host_only;
110             $cookie = $cookie->host_only($bool);
111              
112             Host-only flag, indicating that the canonicalized request-host is identical to
113             the cookie's L.
114              
115             =head2 httponly
116              
117             my $bool = $cookie->httponly;
118             $cookie = $cookie->httponly($bool);
119              
120             HttpOnly flag, which can prevent client-side scripts from accessing this
121             cookie.
122              
123             =head2 max_age
124              
125             my $max_age = $cookie->max_age;
126             $cookie = $cookie->max_age(60);
127              
128             Max age for cookie.
129              
130             =head2 path
131              
132             my $path = $cookie->path;
133             $cookie = $cookie->path('/test');
134              
135             Cookie path.
136              
137             =head2 samesite
138              
139             my $samesite = $cookie->samesite;
140             $cookie = $cookie->samesite('Lax');
141              
142             SameSite value. Note that this attribute is B because even though
143             most commonly used browsers support the feature, there is no specification yet
144             besides
145             L.
146              
147             =head2 secure
148              
149             my $bool = $cookie->secure;
150             $cookie = $cookie->secure($bool);
151              
152             Secure flag, which instructs browsers to only send this cookie over HTTPS
153             connections.
154              
155             =head1 METHODS
156              
157             L inherits all methods from L and
158             implements the following new ones.
159              
160             =head2 parse
161              
162             my $cookies = Mojo::Cookie::Response->parse('f=b; path=/');
163              
164             Parse cookies.
165              
166             =head2 to_string
167              
168             my $str = $cookie->to_string;
169              
170             Render cookie.
171              
172             =head1 SEE ALSO
173              
174             L, L, L.
175              
176             =cut