File Coverage

blib/lib/Net/Amazon/S3/Request.pm
Criterion Covered Total %
statement 38 38 100.0
branch 11 12 91.6
condition 2 3 66.6
subroutine 16 16 100.0
pod 0 1 0.0
total 67 70 95.7


line stmt bran cond sub pod time code
1             $Net::Amazon::S3::Request::VERSION = '0.991';
2             use Moose 0.85;
3 99     99   696 use MooseX::StrictConstructor 0.16;
  99         2416  
  99         737  
4 99     99   558756 use Moose::Util::TypeConstraints;
  99         1597  
  99         621  
5 99     99   270446 use Regexp::Common qw /net/;
  99         549  
  99         860  
6 99     99   224909  
  99         227888  
  99         404  
7             # ABSTRACT: Base class for request objects
8              
9             use Net::Amazon::S3::Constraint::ACL::Canned;
10 99     99   247187  
  99         226  
  99         85201  
11             enum 'LocationConstraint' => [
12             # https://docs.aws.amazon.com/general/latest/gr/rande.html#s3_region
13             # https://docs.aws.amazon.com/AmazonS3/latest/API/API_CreateBucket.html#API_CreateBucket_RequestSyntax
14             'af-south-1',
15             'ap-east-1',
16             'ap-northeast-1',
17             'ap-northeast-2',
18             'ap-northeast-3',
19             'ap-south-1',
20             'ap-southeast-1',
21             'ap-southeast-2',
22             'ca-central-1',
23             'cn-north-1',
24             'cn-northwest-1',
25             'EU',
26             'eu-central-1',
27             'eu-north-1',
28             'eu-south-1',
29             'eu-west-1',
30             'eu-west-2',
31             'eu-west-3',
32             'me-south-1',
33             'sa-east-1',
34             'us-east-1',
35             'us-east-2',
36             'us-gov-east-1',
37             'us-gov-west-1',
38             'us-west-1',
39             'us-west-2',
40             ];
41              
42             subtype 'MaybeLocationConstraint'
43             => as 'Maybe[LocationConstraint]'
44             ;
45              
46             # maintain backward compatiblity with 'US' and 'EU' values
47             my %location_constraint_alias = (
48             US => 'us-east-1',
49             EU => 'eu-west-1',
50             );
51              
52             enum 'LocationConstraintAlias' => [ keys %location_constraint_alias ];
53              
54             coerce 'LocationConstraint'
55             => from 'LocationConstraintAlias'
56             => via { $location_constraint_alias{$_} }
57             ;
58              
59             coerce 'MaybeLocationConstraint'
60             => from 'LocationConstraintAlias'
61             => via { $location_constraint_alias{$_} }
62             ;
63              
64             # To comply with Amazon S3 requirements, bucket names must:
65             # Contain lowercase letters, numbers, periods (.), underscores (_), and dashes (-)
66             # Start with a number or letter
67             # Be between 3 and 255 characters long
68             # Not be in an IP address style (e.g., "192.168.5.4")
69              
70             subtype 'BucketName1' => as 'Str' => where {
71             $_ =~ /^[a-zA-Z0-9._-]+$/;
72             } => message {
73             "Bucket name ($_) must contain lowercase letters, numbers, periods (.), underscores (_), and dashes (-)";
74             };
75              
76             subtype 'BucketName2' => as 'BucketName1' => where {
77             $_ =~ /^[a-zA-Z0-9]/;
78             } => message {
79             "Bucket name ($_) must start with a number or letter";
80             };
81              
82             subtype 'BucketName3' => as 'BucketName2' => where {
83             length($_) >= 3 && length($_) <= 255;
84             } => message {
85             "Bucket name ($_) must be between 3 and 255 characters long";
86             };
87              
88             subtype 'BucketName' => as 'BucketName3' => where {
89             $_ !~ /^$RE{net}{IPv4}$/;
90             } => message {
91             "Bucket name ($_) must not be in an IP address style (e.g., '192.168.5.4')";
92             };
93              
94             has 's3' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 );
95              
96             has '_http_request_content' => (
97             is => 'ro',
98             init_arg => undef,
99             isa => 'Maybe[Str]',
100             lazy => 1,
101             builder => '_request_content',
102             );
103              
104             __PACKAGE__->meta->make_immutable;
105              
106             '';
107             }
108 139     139   3314  
109             '';
110             }
111              
112 430     430   14665 }
113              
114             }
115       358      
116             }
117              
118       464     my ($self) = @_;
119              
120             my %query_params = $self->_request_query_params;
121       416      
122             my @parts = (
123             ($self->_request_query_action) x!! $self->_request_query_action,
124             map "$_=${\ $self->s3->_urlencode( $query_params{$_} ) }", sort keys %query_params,
125 416     416   10719 );
126              
127 416         1310 return '' unless @parts;
128             return '?' . join '&', @parts;
129 416         1522 }
130              
131 74         2439 my ($self) = @_;
132              
133             return $self->_request_path . $self->_request_query_string;
134 416 100       3416 }
135 232         1149  
136             my ($self) = @_;
137              
138             return +{ $self->_request_headers };
139 416     416   777 }
140              
141 416         1688 my ($self, %params) = @_;
142              
143             $params{path} = $self->_http_request_path unless exists $params{path};
144             $params{method} = $self->_http_request_method unless exists $params{method};
145 430     430   813 $params{headers} = $self->_http_request_headers unless exists $params{headers};
146             $params{content} = $self->_http_request_content unless exists $params{content} or ! defined $self->_http_request_content;
147 430         1396  
148             # Although Amazon's Signature 4 test suite explicitely handles // it appears
149             # it's inconsistent with their implementation so removing it here
150             $params{path} =~ s{//+}{/}g;
151 430     430   1175  
152             return Net::Amazon::S3::HTTPRequest->new(
153 430 100       1829 %params,
154 430 100       14023 s3 => $self->s3,
155 430 50       1739 $self->can( 'bucket' ) ? (bucket => $self->bucket) : (),
156 430 100 66     10532 );
157             }
158              
159             my ($self, %params) = @_;
160 430         1085  
161             return $self->_build_signed_request( %params )->http_request;
162 430 100       9985 }
163              
164             my $self = shift;
165              
166             return $self->_build_http_request;
167             }
168              
169             1;
170 210     210   552  
171              
172 210         794 =pod
173              
174             =encoding UTF-8
175              
176 294     294 0 525 =head1 NAME
177              
178 294         949 Net::Amazon::S3::Request - Base class for request objects
179              
180             =head1 VERSION
181              
182             version 0.991
183              
184             =head1 SYNOPSIS
185              
186             # do not instantiate directly
187              
188             =head1 DESCRIPTION
189              
190             This module is a base class for all the Net::Amazon::S3::Request::*
191             classes.
192              
193             =head1 AUTHOR
194              
195             Branislav Zahradník <barney@cpan.org>
196              
197             =head1 COPYRIGHT AND LICENSE
198              
199             This software is copyright (c) 2022 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover, Branislav Zahradník.
200              
201             This is free software; you can redistribute it and/or modify it under
202             the same terms as the Perl 5 programming language system itself.
203              
204             =cut