Newer Older
183 lines | 4.046kb
copy gitweblite soruce code
root authored on 2012-11-23
1
package Mojo::Cookie::Response;
2
use Mojo::Base 'Mojo::Cookie';
3

            
4
use Mojo::Date;
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
5
use Mojo::Util qw(quote split_header);
copy gitweblite soruce code
root authored on 2012-11-23
6

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
7
has [qw(domain httponly max_age origin path secure)];
copy gitweblite soruce code
root authored on 2012-11-23
8

            
9
sub expires {
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
10
  my $self = shift;
copy gitweblite soruce code
root authored on 2012-11-23
11

            
12
  # Upgrade
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
13
  my $e = $self->{expires};
14
  return $self->{expires} = defined $e && !ref $e ? Mojo::Date->new($e) : $e
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
15
    unless @_;
16
  $self->{expires} = shift;
17

            
18
  return $self;
copy gitweblite soruce code
root authored on 2012-11-23
19
}
20

            
21
sub parse {
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
22
  my ($self, $str) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
23

            
24
  my @cookies;
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
25
  my $tree = split_header(defined $str ? $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, @{my $elem = shift @$tree; defined $elem ? $elem : []};
34
        my $len = (defined $pairs->[0] ? $pairs->[0] : '') =~ /-/ ? 6 : 10;
35
        $value .= join ' ', ',', grep {defined} splice @$pairs, 0, $len;
36
      }
copy gitweblite soruce code
root authored on 2012-11-23
37

            
38
      # This will only run once
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
39
      push @cookies, $self->new(name => $name, value => defined $value ? $value : '') and next
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
40
        unless $i++;
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
41

            
42
      # Attributes (Netscape and RFC 6265)
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
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);
copy gitweblite soruce code
root authored on 2012-11-23
48
    }
49
  }
50

            
51
  return \@cookies;
52
}
53

            
54
sub to_string {
55
  my $self = shift;
56

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
57
  # Name and value (Netscape)
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
58
  return '' unless length(my $name = defined $self->name ? $self->name : '');
copy gitweblite soruce code
root authored on 2012-11-23
59
  my $value = defined $self->value ? $self->value : '';
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
60
  my $cookie = join '=', $name, $value =~ /[,;" ]/ ? quote($value) : $value;
copy gitweblite soruce code
root authored on 2012-11-23
61

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
62
  # "expires" (Netscape)
63
  if (defined(my $e = $self->expires)) { $cookie .= "; expires=$e" }
copy gitweblite soruce code
root authored on 2012-11-23
64

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
65
  # "domain" (Netscape)
66
  if (my $domain = $self->domain) { $cookie .= "; domain=$domain" }
copy gitweblite soruce code
root authored on 2012-11-23
67

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
68
  # "path" (Netscape)
69
  if (my $path = $self->path) { $cookie .= "; path=$path" }
copy gitweblite soruce code
root authored on 2012-11-23
70

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
71
  # "secure" (Netscape)
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
72
  $cookie .= "; secure" if $self->secure;
copy gitweblite soruce code
root authored on 2012-11-23
73

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
74
  # "Max-Age" (RFC 6265)
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
75
  if (defined(my $max = $self->max_age)) { $cookie .= "; Max-Age=$max" }
copy gitweblite soruce code
root authored on 2012-11-23
76

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
77
  # "HttpOnly" (RFC 6265)
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
78
  $cookie .= "; HttpOnly" if $self->httponly;
copy gitweblite soruce code
root authored on 2012-11-23
79

            
80
  return $cookie;
81
}
82

            
83
1;
84

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
85
=encoding utf8
86

            
copy gitweblite soruce code
root authored on 2012-11-23
87
=head1 NAME
88

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
89
Mojo::Cookie::Response - HTTP response cookie
copy gitweblite soruce code
root authored on 2012-11-23
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');
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
98
  say "$cookie";
copy gitweblite soruce code
root authored on 2012-11-23
99

            
100
=head1 DESCRIPTION
101

            
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
102
L<Mojo::Cookie::Response> is a container for HTTP response cookies as
103
described in RFC 6265.
copy gitweblite soruce code
root authored on 2012-11-23
104

            
105
=head1 ATTRIBUTES
106

            
107
L<Mojo::Cookie::Response> inherits all attributes from L<Mojo::Cookie> and
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
108
implements the following new ones.
copy gitweblite soruce code
root authored on 2012-11-23
109

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
110
=head2 domain
copy gitweblite soruce code
root authored on 2012-11-23
111

            
112
  my $domain = $cookie->domain;
113
  $cookie    = $cookie->domain('localhost');
114

            
115
Cookie domain.
116

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
117
=head2 httponly
copy gitweblite soruce code
root authored on 2012-11-23
118

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
119
  my $bool = $cookie->httponly;
120
  $cookie  = $cookie->httponly($bool);
copy gitweblite soruce code
root authored on 2012-11-23
121

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
122
HttpOnly flag, which can prevent client-side scripts from accessing this
copy gitweblite soruce code
root authored on 2012-11-23
123
cookie.
124

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
125
=head2 max_age
copy gitweblite soruce code
root authored on 2012-11-23
126

            
127
  my $max_age = $cookie->max_age;
128
  $cookie     = $cookie->max_age(60);
129

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
130
Max age for cookie.
copy gitweblite soruce code
root authored on 2012-11-23
131

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
132
=head2 origin
133

            
134
  my $origin = $cookie->origin;
135
  $cookie    = $cookie->origin('mojolicio.us');
136

            
137
Origin of the cookie.
138

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
139
=head2 path
copy gitweblite soruce code
root authored on 2012-11-23
140

            
141
  my $path = $cookie->path;
142
  $cookie  = $cookie->path('/test');
143

            
144
Cookie path.
145

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
146
=head2 secure
copy gitweblite soruce code
root authored on 2012-11-23
147

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
148
  my $bool = $cookie->secure;
149
  $cookie  = $cookie->secure($bool);
copy gitweblite soruce code
root authored on 2012-11-23
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

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
159
=head2 expires
copy gitweblite soruce code
root authored on 2012-11-23
160

            
161
  my $expires = $cookie->expires;
162
  $cookie     = $cookie->expires(time + 60);
163
  $cookie     = $cookie->expires(Mojo::Date->new(time + 60));
164

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
165
Expiration for cookie.
copy gitweblite soruce code
root authored on 2012-11-23
166

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
167
=head2 parse
copy gitweblite soruce code
root authored on 2012-11-23
168

            
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
169
  my $cookies = Mojo::Cookie::Response->parse('f=b; path=/');
copy gitweblite soruce code
root authored on 2012-11-23
170

            
171
Parse cookies.
172

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
173
=head2 to_string
copy gitweblite soruce code
root authored on 2012-11-23
174

            
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
175
  my $str = $cookie->to_string;
copy gitweblite soruce code
root authored on 2012-11-23
176

            
177
Render cookie.
178

            
179
=head1 SEE ALSO
180

            
181
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
182

            
183
=cut