/
Cookies.pm
132 lines (95 loc) · 3.48 KB
/
Cookies.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
package Dancer::Cookies;
#ABSTRACT: a singleton storage for all cookies
use strict;
use warnings;
use Dancer::Cookie;
use Dancer::SharedData;
use URI::Escape;
# all cookies defined by the application are store in that singleton
# this is a hashref the represent all key/value pairs to store as cookies
my $COOKIES = {};
sub cookies {$COOKIES}
sub init {
$COOKIES = parse_cookie_from_env();
}
sub cookie {
my $class = shift;
my $name = shift;
my $value = shift;
defined $value && set_cookie( $class, $name, $value, @_ );
cookies->{$name} ? cookies->{$name}->value : undef;
}
sub parse_cookie_from_env {
my $request = Dancer::SharedData->request;
my $env = (defined $request) ? $request->env : {};
my $env_str = $env->{COOKIE} || $env->{HTTP_COOKIE};
return {} unless defined $env_str;
my $cookies = {};
foreach my $cookie ( split( /[,;]\s?/, $env_str ) ) {
# here, we don't want more than the 2 first elements
# a cookie string can contains something like:
# cookie_name="foo=bar"
# we want `cookie_name' as the value and `foo=bar' as the value
my( $name, $value ) = split /\s*=\s*/, $cookie, 2;
# catch weird entries like 'cookie1=foo;;cookie2=bar'
next unless length $name;
my @values;
if ( defined $value && $value ne '' ) {
@values = map { uri_unescape($_) } split( /[&;]/, $value );
}
$cookies->{$name} =
Dancer::Cookie->new( name => $name, value => \@values );
}
return $cookies;
}
# set_cookie name => value,
# expires => time() + 3600, domain => '.foo.com'
# http_only => 0 # defaults to 1
sub set_cookie {
my ( $class, $name, $value, %options ) = @_;
my $cookie = Dancer::Cookie->new(
name => $name,
value => $value,
%options
);
Dancer::Cookies->set_cookie_object($name => $cookie);
}
sub set_cookie_object {
my ($class, $name, $cookie) = @_;
Dancer::SharedData->response->add_cookie($name, $cookie);
Dancer::Cookies->cookies->{$name} = $cookie;
}
1;
__END__
=head1 SYNOPSIS
use Dancer::Cookies;
my $cookies = Dancer::Cookies->cookies;
foreach my $name ( keys %{$cookies} ) {
my $cookie = $cookies->{$name};
my $value = $cookie->value;
print "$name => $value\n";
}
cookie lang => "fr-FR"; #set a cookie and return its value
cookie lang => "fr-FR", expires => "2 hours";
cookie "lang" #return a cookie value
=head1 DESCRIPTION
Dancer::Cookies keeps all the cookies defined by the application and makes them
accessible and provides a few helper functions for cookie handling with regards
to the stored cookies.
=head1 METHODS
=head2 init
This method is called when C<< ->new() >> is called. It creates a storage of
cookies parsed from the environment using C<parse_cookies_from_env> described
below.
=head2 cookies
Returns a hash reference of all cookies, all objects of L<Dancer::Cookie> type.
The key is the cookie name, the value is the L<Dancer::Cookie> object.
=head2 cookie
C<cookie> method is useful to query or set cookies easily.
cookie lang => "fr-FR"; # set a cookie and return its value
cookie lang => "fr-FR", expires => "2 hours"; # extra cookie info
cookie "lang" # return a cookie value
=head2 parse_cookie_from_env
Fetches all the cookies from the environment, parses them and creates a hashref
of all cookies.
It also returns all the hashref it created.