1package Shared::Examples::Net::Amazon::S3::Request; 2# ABSTRACT: used for testing and as example 3$Shared::Examples::Net::Amazon::S3::Request::VERSION = '0.99'; 4use strict; 5use warnings; 6 7use parent qw[ Exporter::Tiny ]; 8 9use Test::More; 10use Test::Deep; 11 12use Moose qw[]; 13use Moose::Object; 14use Moose::Util; 15use XML::LibXML; 16 17use Net::Amazon::S3; 18use Net::Amazon::S3::Bucket; 19 20use Shared::Examples::Net::Amazon::S3; 21 22our @EXPORT_OK = ( 23 qw[ behaves_like_net_amazon_s3_request ], 24 qw[ expect_request_class ], 25 qw[ expect_request_instance ], 26); 27 28sub _canonical_xml { 29 my ($xml) = @_; 30 31 return $xml unless $xml; 32 return $xml if ref $xml; 33 34 my $canonical = eval { 35 XML::LibXML->load_xml ( 36 string => $xml, 37 no_blanks => 1, 38 )->toStringC14N 39 }; 40 41 return $xml unless defined $canonical; 42 return $canonical; 43} 44 45sub _test_meta_build_http_request { 46 my ($self, %params) = @_; 47 48 return $self->_build_signed_request (%params); 49} 50 51sub _test_class { 52 my ($request_class, %params) = @_; 53 54 $params{superclasses} ||= []; 55 $params{methods}{_build_http_request} = \& _test_meta_build_http_request; 56 57 push @{ $params{superclasses} }, $request_class; 58 59 return Moose::Meta::Class->create_anon_class (%params); 60} 61 62sub expect_request_class { 63 my ($request_class) = @_; 64 65 local $Test::Builder::Level = $Test::Builder::Level + 1; 66 67 return use_ok $request_class; 68} 69 70sub expect_request_instance { 71 my (%params) = @_; 72 73 local $Test::Builder::Level = $Test::Builder::Level + 1; 74 75 my %with = map +( substr ($_, 5) => delete $params{$_} ), 76 grep m/^with_/, 77 keys %params 78 ; 79 80 $with{s3} = Shared::Examples::Net::Amazon::S3::s3_api_with_signature_2 ( 81 host => $params{with_host} || 's3.amazonaws.com', 82 ); 83 84 my $test_class = _test_class $params{request_class}, 85 map +( $_ => $params{$_} ), 86 grep exists $params{$_}, 87 qw [ roles ], 88 ; 89 90 my $request = eval { $test_class->name->new (%with) }; 91 my $error = $@; 92 93 if (exists $params{throws}) { 94 if (defined $request) { 95 fail "create instance should fail"; 96 } else { 97 cmp_deeply $error, $params{throws}, "create instance should fail"; 98 } 99 } else { 100 ok defined $request, "should create (mocked) instance of $params{request_class}" 101 or diag $error; 102 } 103 104 return $request; 105} 106 107sub expect_request_uri { 108 my ($request, $expected) = @_; 109 110 local $Test::Builder::Level = $Test::Builder::Level + 1; 111 112 return cmp_deeply 113 $request->http_request->request_uri, 114 $expected, 115 "it builds expected request uri" 116 ; 117} 118 119sub expect_request_method { 120 my ($request, $expected) = @_; 121 122 local $Test::Builder::Level = $Test::Builder::Level + 1; 123 124 return cmp_deeply 125 $request->http_request->method, 126 $expected, 127 "it builds expected request method" 128 ; 129} 130 131sub expect_request_headers { 132 my ($request, $expected) = @_; 133 134 local $Test::Builder::Level = $Test::Builder::Level + 1; 135 136 return cmp_deeply 137 $request->http_request->headers, 138 $expected, 139 "it builds expected request headers" 140 ; 141} 142 143sub expect_request_content { 144 my ($request, $expected) = @_; 145 146 local $Test::Builder::Level = $Test::Builder::Level + 1; 147 148 # XML builders doesn't need to produce whitespaces for readability 149 # wherease test expectation should be as readable as possible 150 # compare canonicalized xml strings than 151 152 return is 153 _canonical_xml ($request->http_request->content), 154 _canonical_xml ($expected), 155 "it builds expected request XML content" 156 ; 157} 158 159sub behaves_like_net_amazon_s3_request { 160 my ($title, %params) = @_; 161 162 local $Test::Builder::Level = $Test::Builder::Level + 1; 163 164 subtest $title => sub { 165 plan tests => 2 + scalar grep exists $params{$_}, 166 qw[ expect_request_uri ], 167 qw[ expect_request_method ], 168 qw[ expect_request_headers ], 169 qw[ expect_request_content ], 170 ; 171 172 expect_request_class $params{request_class}; 173 my $request = expect_request_instance %params; 174 175 expect_request_uri $request => $params{expect_request_uri} 176 if exists $params{expect_request_uri}; 177 178 expect_request_method $request => $params{expect_request_method} 179 if exists $params{expect_request_method}; 180 181 expect_request_headers $request => $params{expect_request_headers} 182 if exists $params{expect_request_headers}; 183 184 expect_request_content $request => $params{expect_request_content} 185 if exists $params{expect_request_content}; 186 }; 187} 188 1891; 190 191__END__ 192 193=pod 194 195=encoding UTF-8 196 197=head1 NAME 198 199Shared::Examples::Net::Amazon::S3::Request - used for testing and as example 200 201=head1 VERSION 202 203version 0.99 204 205=head1 AUTHOR 206 207Branislav Zahradník <barney@cpan.org> 208 209=head1 COPYRIGHT AND LICENSE 210 211This software is copyright (c) 2021 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover, Branislav Zahradník. 212 213This is free software; you can redistribute it and/or modify it under 214the same terms as the Perl 5 programming language system itself. 215 216=cut 217