File Coverage

blib/lib/Shared/Examples/Net/Amazon/S3/Fixture.pm
Criterion Covered Total %
statement 15 15 100.0
branch 2 2 100.0
condition n/a
subroutine 5 5 100.0
pod 0 3 0.0
total 22 25 88.0


line stmt bran cond sub pod time code
1             package Shared::Examples::Net::Amazon::S3::Fixture;
2             # ABSTRACT: used for testing to provide test fixtures
3             $Shared::Examples::Net::Amazon::S3::Fixture::VERSION = '0.99';
4 40     40   309 use parent qw[ Exporter::Tiny ];
  40         97  
  40         415  
5              
6 40     40   3235 use HTTP::Status;
  40         95  
  40         26036  
7              
8             our @EXPORT_OK = (
9             qw[ error_fixture ],
10             qw[ response_fixture ],
11             qw[ fixture ],
12             );
13              
14             sub response_fixture {
15 86     86 0 468 my (%params) = @_;
16              
17             return +{
18             content_type => 'application/xml',
19             content_length => length $params{with_response_data},
20 86         1938 response_code => HTTP::Status::HTTP_OK,
21              
22             %params,
23             };
24             }
25              
26             sub fixture {
27 33     33 0 168 my (%params) = @_;
28              
29             return +{
30             content_type => 'application/xml',
31             content_length => length $params{with_response_data},
32 33         719 response_code => HTTP::Status::HTTP_OK,
33              
34             %params,
35             };
36             }
37              
38             sub error_fixture {
39 86     86 0 377 my ($error_code, $http_status, $error_message) = @_;
40              
41 86 100       440 unless (defined $error_message) {
42 85         227 $error_message = $error_code;
43 85         1229 $error_message =~ s/ (?<=[[:lower:]]) ([[:upper:]])/ \L$1\E/gx;
44             }
45              
46 86         693 return response_fixture (
47             response_code => $http_status,
48             content => <<"XML",
49             <?xml version="1.0" encoding="UTF-8"?>
50             <Error>
51             <Code>$error_code</Code>
52             <Message>$error_message error message</Message>
53             <Resource>/some-resource</Resource>
54             <RequestId>4442587FB7D0A2F9</RequestId>
55             </Error>
56             XML
57             );
58             }
59              
60             1;
61              
62             __END__
63              
64             =pod
65              
66             =encoding UTF-8
67              
68             =head1 NAME
69              
70             Shared::Examples::Net::Amazon::S3::Fixture - used for testing to provide test fixtures
71              
72             =head1 VERSION
73              
74             version 0.99
75              
76             =head1 AUTHOR
77              
78             Branislav ZahradnĂ­k <barney@cpan.org>
79              
80             =head1 COPYRIGHT AND LICENSE
81              
82             This software is copyright (c) 2021 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover, Branislav ZahradnĂ­k.
83              
84             This is free software; you can redistribute it and/or modify it under
85             the same terms as the Perl 5 programming language system itself.
86              
87             =cut