/usr/share/perl5/Dancer2/Core/Cookie.pm is in libdancer2-perl 0.204002+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | package Dancer2::Core::Cookie;
# ABSTRACT: A cookie representing class
$Dancer2::Core::Cookie::VERSION = '0.204002';
use Moo;
use URI::Escape;
use Dancer2::Core::Types;
use Dancer2::Core::Time;
use Carp 'croak';
use overload '""' => \&_get_value;
BEGIN {
my $try_xs =
exists($ENV{PERL_HTTP_XSCOOKIES}) ? !!$ENV{PERL_HTTP_XSCOOKIES} :
exists($ENV{PERL_ONLY}) ? !$ENV{PERL_ONLY} :
1;
my $use_xs = 0;
$try_xs and eval {
require HTTP::XSCookies;
$use_xs++;
};
if ( $use_xs ) {
*to_header = \&xs_to_header;
}
else {
*to_header = \&pp_to_header;
}
*_USE_XS = $use_xs ? sub () { !!1 } : sub () { !!0 };
}
sub xs_to_header {
my $self = shift;
return HTTP::XSCookies::bake_cookie(
$self->name,
{ value => join('&', $self->value),
path => $self->path,
domain => $self->domain,
expires => $self->expires,
httponly => $self->http_only,
secure => $self->secure,
}
);
}
sub pp_to_header {
my $self = shift;
my $value = join( '&', map uri_escape($_), $self->value );
my $no_httponly = defined( $self->http_only ) && $self->http_only == 0;
my @headers = $self->name . '=' . $value;
push @headers, "Path=" . $self->path if $self->path;
push @headers, "Expires=" . $self->expires if $self->expires;
push @headers, "Domain=" . $self->domain if $self->domain;
push @headers, "Secure" if $self->secure;
push @headers, 'HttpOnly' unless $no_httponly;
return join '; ', @headers;
}
has value => (
is => 'rw',
isa => ArrayRef,
required => 0,
coerce => sub {
my $value = shift;
my @values =
ref $value eq 'ARRAY' ? @$value
: ref $value eq 'HASH' ? %$value
: ($value);
return [@values];
},
);
around value => sub {
my $orig = shift;
my $self = shift;
my $array = $orig->( $self, @_ );
return wantarray ? @$array : $array->[0];
};
# this is only for overloading; need a real sub to refer to, as the Moose
# attribute accessor won't be available at that point.
sub _get_value { shift->value }
has name => (
is => 'rw',
isa => Str,
required => 1,
);
has expires => (
is => 'rw',
isa => Str,
required => 0,
coerce => sub {
Dancer2::Core::Time->new( expression => $_[0] )->gmt_string;
},
);
has domain => (
is => 'rw',
isa => Str,
required => 0,
);
has path => (
is => 'rw',
isa => Str,
default => sub {'/'},
predicate => 1,
);
has secure => (
is => 'rw',
isa => Bool,
required => 0,
default => sub {0},
);
has http_only => (
is => 'rw',
isa => Bool,
required => 0,
default => sub {0},
);
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Dancer2::Core::Cookie - A cookie representing class
=head1 VERSION
version 0.204002
=head1 SYNOPSIS
use Dancer2::Core::Cookie;
my $cookie = Dancer2::Core::Cookie->new(
name => $cookie_name, value => $cookie_value
);
my $value = $cookie->value;
print "$cookie"; # objects stringify to their value.
=head1 DESCRIPTION
Dancer2::Core::Cookie provides a HTTP cookie object to work with cookies.
=head1 ATTRIBUTES
=head2 value
The cookie's value.
(Note that cookie objects use overloading to stringify to their value, so if
you say e.g. return "Hi, $cookie", you'll get the cookie's value there.)
In list context, returns a list of potentially multiple values; in scalar
context, returns just the first value. (So, if you expect a cookie to have
multiple values, use list context.)
=head2 name
The cookie's name.
=head2 expires
The cookie's expiration date. There are several formats.
Unix epoch time like 1288817656 to mean "Wed, 03-Nov-2010 20:54:16 GMT"
It also supports a human readable offset from the current time such as "2 hours".
See the documentation of L<Dancer2::Core::Time> for details of all supported
formats.
=head2 domain
The cookie's domain.
=head2 path
The cookie's path.
=head2 secure
If true, it instructs the client to only serve the cookie over secure
connections such as https.
=head2 http_only
By default, cookies are created with a property, named C<HttpOnly>,
that can be used for security, forcing the cookie to be used only by
the server (via HTTP) and not by any JavaScript code.
If your cookie is meant to be used by some JavaScript code, set this
attribute to 0.
=head1 METHODS
=head2 my $cookie=Dancer2::Core::Cookie->new(%opts);
Create a new Dancer2::Core::Cookie object.
You can set any attribute described in the I<ATTRIBUTES> section above.
=head2 my $header=$cookie->to_header();
Creates a proper HTTP cookie header from the content.
=head1 AUTHOR
Dancer Core Developers
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2016 by Alexis Sukrieh.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|