File Coverage

lib/HTTP/Promise/Headers/StrictTransportSecurity.pm
Criterion Covered Total %
statement 43 44 97.7
branch 5 10 50.0
condition 2 3 66.6
subroutine 15 16 93.7
pod 9 9 100.0
total 74 82 90.2


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Asynchronous HTTP Request and Promise - ~/lib/HTTP/Promise/Headers/StrictTransportSecurity.pm
3             ## Version v0.1.0
4             ## Copyright(c) 2022 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2022/05/08
7             ## Modified 2022/05/08
8             ## All rights reserved.
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package HTTP::Promise::Headers::StrictTransportSecurity;
15             BEGIN
16             {
17 3     3   3331 use strict;
  3         7  
  3         105  
18 3     3   15 use warnings;
  3         8  
  3         80  
19 3     3   16 use warnings::register;
  3         7  
  3         467  
20 3     3   19 use parent qw( HTTP::Promise::Headers::Generic );
  3         6  
  3         14  
21 3     3   275 our $VERSION = 'v0.1.0';
22             };
23              
24 3     3   17 use strict;
  3         14  
  3         61  
25 3     3   15 use warnings;
  3         6  
  3         1445  
26              
27             sub init
28             {
29 4     4 1 343764 my $self = shift( @_ );
30 4         232 $self->{properties} = {};
31 4         22 $self->{params} = [];
32 4 50 66     55 @_ = () if( @_ == 1 && $self->_is_a( $_[0] => 'Module::Generic::Null' ) );
33 4 100       103 if( @_ )
34             {
35 2         7 my $this = shift( @_ );
36 2 50       25 my $ref = $self->new_array( $self->_is_array( $this ) ? $this : [split( /[[:blank:]\h]*(?<!\\)\;[[:blank:]\h]*/, "$this" )] );
37 2         154 my $params = $self->params;
38 2         1661 my $props = $self->properties;
39 2         2667 foreach my $pair ( @$ref )
40             {
41 6         46 my( $prop, $val ) = split( /=/, $pair, 2 );
42 6         25 $props->{ $prop } = $val;
43 6         141 $params->push( $prop );
44             }
45             }
46 4         59 $self->{_init_strict_use_sub} = 1;
47 4 50       33 $self->SUPER::init( @_ ) || return( $self->pass_error );
48 4         27 $self->_field_name( 'Strict-Transport-Security' );
49 4         3248 return( $self );
50             }
51              
52 5     5 1 675 sub as_string { return( shift->_set_get_properties_as_string( sep => ';' ) ); }
53              
54 5     5 1 519 sub include_subdomains { return( shift->_set_get_property_boolean( 'includeSubDomains', @_ ) ); }
55              
56 5     5 1 55 sub max_age { return( shift->_set_get_property_number( 'max-age', @_ ) ); }
57              
58 23     23 1 78 sub params { return( shift->_set_get_array_as_object( 'params', @_ ) ); }
59              
60 0 0   0 1 0 sub property { return( shift->_set_get_property_value( @_, ( @_ > 1 ? { needs_quotes => 1 } : () ) ) ); }
61              
62 1     1 1 12 sub property_boolean { return( shift->_set_get_property_boolean( @_ ) ); }
63              
64 23     23 1 87 sub properties { return( shift->_set_get_hash_as_mix_object( 'properties', @_ ) ); }
65              
66 5     5 1 1017 sub preload { return( shift->_set_get_property_boolean( 'preload', @_ ) ); }
67              
68             1;
69             # NOTE: POD
70             __END__
71              
72             =encoding utf-8
73              
74             =head1 NAME
75              
76             HTTP::Promise::Headers::StrictTransportSecurity - Strict-Transport-Security Header Field
77              
78             =head1 SYNOPSIS
79              
80             use HTTP::Promise::Headers::StrictTransportSecurity;
81             my $sts = HTTP::Promise::Headers::StrictTransportSecurity->new ||
82             die( HTTP::Promise::Headers::StrictTransportSecurity->error, "\n" );
83             $sts->include_subdomains(1);
84             $sts->max_age(63072000);
85             $sts->preload(1);
86             say "$sts";
87             # same thing
88             say $sts->as_string;
89              
90             =head1 VERSION
91              
92             v0.1.0
93              
94             =head1 DESCRIPTION
95              
96             The following is an extract from Mozilla documentation.
97              
98             The HTTP Strict-Transport-Security response header (often abbreviated as HSTS) informs browsers that the site should only be accessed using HTTPS, and that any future attempts to access it using HTTP should automatically be converted to HTTPS.
99              
100             Example:
101              
102             Strict-Transport-Security: max-age=63072000; includeSubDomains; preload
103              
104             =head1 METHODS
105              
106             =head2 as_string
107              
108             Returns a string representation of the C<Strict-Transport-Security> object.
109              
110             =head2 include_subdomains
111              
112             Boolean, optional. If provided with a true value, the parameter C<includeSubDomains> will be added.
113              
114             If this optional parameter is enabled, this means that this rule applies to all of the site's subdomains as well.
115              
116             =head2 max_age
117              
118             Integer, required value (but not enforced).
119              
120             The time, in seconds, that the browser should remember that a site is only to be accessed using HTTPS.
121              
122             =head2 param
123              
124             Set or get an arbitrary name-value pair attribute.
125              
126             =head2 params
127              
128             Set or get multiple name-value parameters.
129              
130             Calling this without any parameters, retrieves the associated L<hash object|Module::Generic::Hash>
131              
132             =head2 preload
133              
134             Boolean, optional. If provided with a true value, the parameter C<preload> will be added.
135              
136             =head2 property
137              
138             Sets or gets an arbitrary property.
139              
140             $h->property( community => 'UCI' );
141             my $val = $h->property( 'community' );
142              
143             See also L<rfc7234, section 5.2.3|https://httpwg.org/specs/rfc7234.html#rfc.section.5.2.3>
144              
145             =head2 property_boolean
146              
147             Sets or gets an arbitrary boolean property.
148              
149             $h->property_boolean( private_property => 1 );
150              
151             =head2 properties
152              
153             Returns the L<hash object|Module::Generic::hash> used as a repository of properties.
154              
155             =head1 AUTHOR
156              
157             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
158              
159             =head1 SEE ALSO
160              
161             See also L<rfc6797, section 6.1|https://tools.ietf.org/html/rfc6797#section-6.1> and L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Strict-Transport-Security>
162              
163             L<HTTP::Promise>, L<HTTP::Promise::Request>, L<HTTP::Promise::Response>, L<HTTP::Promise::Message>, L<HTTP::Promise::Entity>, L<HTTP::Promise::Headers>, L<HTTP::Promise::Body>, L<HTTP::Promise::Body::Form>, L<HTTP::Promise::Body::Form::Data>, L<HTTP::Promise::Body::Form::Field>, L<HTTP::Promise::Status>, L<HTTP::Promise::MIME>, L<HTTP::Promise::Parser>, L<HTTP::Promise::IO>, L<HTTP::Promise::Stream>, L<HTTP::Promise::Exception>
164              
165             =head1 COPYRIGHT & LICENSE
166              
167             Copyright(c) 2022 DEGUEST Pte. Ltd.
168              
169             All rights reserved.
170              
171             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
172              
173             =cut