add files
|
1 |
package Mojo::Cookie::Response; |
2 |
use Mojo::Base 'Mojo::Cookie'; |
|
3 | ||
4 |
use Mojo::Date; |
|
5 |
use Mojo::Util qw(quote split_header); |
|
6 | ||
7 |
has [qw(domain httponly max_age origin path secure)]; |
|
8 | ||
9 |
sub expires { |
|
10 |
my $self = shift; |
|
11 | ||
12 |
# Upgrade |
|
13 |
my $e = $self->{expires}; |
|
14 |
return $self->{expires} = defined $e && !ref $e ? Mojo::Date->new($e) : $e |
|
15 |
unless @_; |
|
16 |
$self->{expires} = shift; |
|
17 | ||
18 |
return $self; |
|
19 |
} |
|
20 | ||
21 |
sub parse { |
|
22 |
my ($self, $str) = @_; |
|
23 | ||
24 |
my @cookies; |
|
25 |
my $tree = split_header($str // ''); |
|
26 |
while (my $pairs = shift @$tree) { |
|
27 |
my $i = 0; |
|
28 |
while (@$pairs) { |
|
29 |
my ($name, $value) = (shift @$pairs, shift @$pairs); |
|
30 | ||
31 |
# "expires" is a special case, thank you Netscape... |
|
32 |
if ($name =~ /^expires$/i) { |
|
33 |
push @$pairs, @{shift @$tree // []}; |
|
34 |
my $len = ($pairs->[0] // '') =~ /-/ ? 6 : 10; |
|
35 |
$value .= join ' ', ',', grep {defined} splice @$pairs, 0, $len; |
|
36 |
} |
|
37 | ||
38 |
# This will only run once |
|
39 |
push @cookies, $self->new(name => $name, value => $value // '') and next |
|
40 |
unless $i++; |
|
41 | ||
42 |
# Attributes (Netscape and RFC 6265) |
|
43 |
next unless $name =~ /^(expires|domain|path|secure|max-age|httponly)$/i; |
|
44 |
my $attr = lc $1; |
|
45 |
$attr = 'max_age' if $attr eq 'max-age'; |
|
46 |
$cookies[-1] |
|
47 |
->$attr($attr eq 'secure' || $attr eq 'httponly' ? 1 : $value); |
|
48 |
} |
|
49 |
} |
|
50 | ||
51 |
return \@cookies; |
|
52 |
} |
|
53 | ||
54 |
sub to_string { |
|
55 |
my $self = shift; |
|
56 | ||
57 |
# Name and value (Netscape) |
|
58 |
return '' unless length(my $name = $self->name // ''); |
|
59 |
my $value = $self->value // ''; |
|
60 |
my $cookie = join '=', $name, $value =~ /[,;" ]/ ? quote($value) : $value; |
|
61 | ||
62 |
# "expires" (Netscape) |
|
63 |
if (defined(my $e = $self->expires)) { $cookie .= "; expires=$e" } |
|
64 | ||
65 |
# "domain" (Netscape) |
|
66 |
if (my $domain = $self->domain) { $cookie .= "; domain=$domain" } |
|
67 | ||
68 |
# "path" (Netscape) |
|
69 |
if (my $path = $self->path) { $cookie .= "; path=$path" } |
|
70 | ||
71 |
# "secure" (Netscape) |
|
72 |
$cookie .= "; secure" if $self->secure; |
|
73 | ||
74 |
# "Max-Age" (RFC 6265) |
|
75 |
if (defined(my $max = $self->max_age)) { $cookie .= "; Max-Age=$max" } |
|
76 | ||
77 |
# "HttpOnly" (RFC 6265) |
|
78 |
$cookie .= "; HttpOnly" if $self->httponly; |
|
79 | ||
80 |
return $cookie; |
|
81 |
} |
|
82 | ||
83 |
1; |
|
84 | ||
85 |
=encoding utf8 |
|
86 | ||
87 |
=head1 NAME |
|
88 | ||
89 |
Mojo::Cookie::Response - HTTP response cookie |
|
90 | ||
91 |
=head1 SYNOPSIS |
|
92 | ||
93 |
use Mojo::Cookie::Response; |
|
94 | ||
95 |
my $cookie = Mojo::Cookie::Response->new; |
|
96 |
$cookie->name('foo'); |
|
97 |
$cookie->value('bar'); |
|
98 |
say "$cookie"; |
|
99 | ||
100 |
=head1 DESCRIPTION |
|
101 | ||
102 |
L<Mojo::Cookie::Response> is a container for HTTP response cookies as |
|
103 |
described in RFC 6265. |
|
104 | ||
105 |
=head1 ATTRIBUTES |
|
106 | ||
107 |
L<Mojo::Cookie::Response> inherits all attributes from L<Mojo::Cookie> and |
|
108 |
implements the following new ones. |
|
109 | ||
110 |
=head2 domain |
|
111 | ||
112 |
my $domain = $cookie->domain; |
|
113 |
$cookie = $cookie->domain('localhost'); |
|
114 | ||
115 |
Cookie domain. |
|
116 | ||
117 |
=head2 httponly |
|
118 | ||
119 |
my $bool = $cookie->httponly; |
|
120 |
$cookie = $cookie->httponly($bool); |
|
121 | ||
122 |
HttpOnly flag, which can prevent client-side scripts from accessing this |
|
123 |
cookie. |
|
124 | ||
125 |
=head2 max_age |
|
126 | ||
127 |
my $max_age = $cookie->max_age; |
|
128 |
$cookie = $cookie->max_age(60); |
|
129 | ||
130 |
Max age for cookie. |
|
131 | ||
132 |
=head2 origin |
|
133 | ||
134 |
my $origin = $cookie->origin; |
|
135 |
$cookie = $cookie->origin('mojolicio.us'); |
|
136 | ||
137 |
Origin of the cookie. |
|
138 | ||
139 |
=head2 path |
|
140 | ||
141 |
my $path = $cookie->path; |
|
142 |
$cookie = $cookie->path('/test'); |
|
143 | ||
144 |
Cookie path. |
|
145 | ||
146 |
=head2 secure |
|
147 | ||
148 |
my $bool = $cookie->secure; |
|
149 |
$cookie = $cookie->secure($bool); |
|
150 | ||
151 |
Secure flag, which instructs browsers to only send this cookie over HTTPS |
|
152 |
connections. |
|
153 | ||
154 |
=head1 METHODS |
|
155 | ||
156 |
L<Mojo::Cookie::Response> inherits all methods from L<Mojo::Cookie> and |
|
157 |
implements the following new ones. |
|
158 | ||
159 |
=head2 expires |
|
160 | ||
161 |
my $expires = $cookie->expires; |
|
162 |
$cookie = $cookie->expires(time + 60); |
|
163 |
$cookie = $cookie->expires(Mojo::Date->new(time + 60)); |
|
164 | ||
165 |
Expiration for cookie. |
|
166 | ||
167 |
=head2 parse |
|
168 | ||
169 |
my $cookies = Mojo::Cookie::Response->parse('f=b; path=/'); |
|
170 | ||
171 |
Parse cookies. |
|
172 | ||
173 |
=head2 to_string |
|
174 | ||
175 |
my $str = $cookie->to_string; |
|
176 | ||
177 |
Render cookie. |
|
178 | ||
179 |
=head1 SEE ALSO |
|
180 | ||
181 |
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. |
|
182 | ||
183 |
=cut |