File Coverage

blib/lib/XAO/DO/Web/Cookie.pm
Criterion Covered Total %
statement 19 19 100.0
branch 13 18 72.2
condition n/a
subroutine 4 4 100.0
pod 1 1 100.0
total 37 42 88.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             XAO::DO::Web::Cookie - cookies manipulations
4              
5             =head1 SYNOPSIS
6              
7             Hello, <%Cookie/html name="customername"%>
8              
9             <%Cookie name="customername" value={<%CgiParam/f param="cname"%>}"%>
10              
11             =head1 DESCRIPTION
12              
13             Displays or sets a cookie. Arguments are:
14              
15             name => cookie name
16             value => cookie value; nothing is displayed if a value is given
17             default => what to display if there is no cookie set, nothing by default
18             expires => when to expire the cookie (same as in CGI->cookie)
19             path => cookie visibility path (same as in CGI->cookie)
20             domain => cookie domain (same as in CGI->cookie)
21             secure => cookie secure flag (same as in CGI->cookie)
22             httponly=> cookie httpOnly flag (same as in CGI->cookie)
23             samesite=> cookie SameSite flag (Strict, Lax, or None)
24             received=> when retrieving only look at actually received cookies (the
25             default is to return a cookie value possibly set earlier
26             in the page render)
27              
28             =cut
29              
30             ###############################################################################
31             package XAO::DO::Web::Cookie;
32 2     2   1525 use strict;
  2         10  
  2         72  
33 2     2   11 use XAO::Utils;
  2         5  
  2         172  
34 2     2   13 use base XAO::Objects->load(objname => 'Web::Page');
  2         4  
  2         19  
35              
36             our $VERSION='2.004';
37              
38             ###############################################################################
39              
40             sub display ($;%) {
41 8     8 1 11 my $self=shift;
42 8         18 my $args=get_args(\@_);
43              
44 8         73 my $name=$args->{'name'};
45 8 50       19 defined($name) || throw $self "- no name given";
46              
47 8 100       25 if(defined($args->{'value'})) {
48             $self->siteconfig->add_cookie(
49             -name => $name,
50             -value => $args->{'value'},
51             -path => $args->{'path'},
52             #
53             ($args->{'expires'} ? (-expires => $args->{'expires'}) : ()),
54             ($args->{'domain'} ? (-domain => $args->{'domain'}) : ()),
55             ($args->{'secure'} ? (-secure => $args->{'secure'}) : ()),
56             ($args->{'httponly'} ? (-httponly => $args->{'httponly'}) : ()),
57 6 100       23 ($args->{'samesite'} ? (-samesite => $args->{'samesite'}) : ()),
    50          
    100          
    50          
    100          
58             );
59             }
60             else {
61 2         6 my $c=$self->siteconfig->get_cookie($name,$args->{'received'});
62 2 50       8 defined $c || ($c=$args->{'default'});
63 2 50       4 defined $c || ($c='');
64              
65 2         10 $self->textout($c);
66             }
67             }
68              
69             ###############################################################################
70             1;
71             __END__