view release on metacpan or  search on metacpan

lib/Dancer2/Core/Cookie.pm  view on Meta::CPAN

package Dancer2::Core::Cookie;
# ABSTRACT: A cookie representing class
$Dancer2::Core::Cookie::VERSION = '2.1.0';
use Moo;
use URI::Escape;
use Dancer2::Core::Types;
use Dancer2::Core::Time;
use Carp 'croak';
use Ref::Util qw< is_arrayref is_hashref >;
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;

    # HTTP::XSCookies can't handle multi-value cookies.
    return $self->pp_to_header(@_) if @{[ $self->value ]} > 1;

    return HTTP::XSCookies::bake_cookie(
        $self->name,
        {   value    => $self->value,
            path     => $self->path,
            domain   => $self->domain,
            expires  => $self->expires,
            httponly => $self->http_only,
            secure   => $self->secure,
            samesite => $self->same_site,
        }
    );
}

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, "SameSite=" . $self->same_site if $self->same_site;
    push @headers, "Secure"                       if $self->secure;
    push @headers, 'HttpOnly' unless $no_httponly;

    return join '; ', @headers;
}

has value => (
    is       => 'rw',