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