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