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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
package App::Glacier::Bre;
use strict;
use warnings;
use parent 'Net::Amazon::Glacier';
use App::Glacier::HttpCatch;
use Carp;
use version 0.77;
sub new {
my ($class, %opts) = @_;
my $region = delete $opts{region} or croak 'region must be supplied';
my $access = delete $opts{access} or croak 'access must be supplied';
my $secret = delete $opts{secret} or croak 'secret must be supplied';
$class->SUPER::new($region, $access, $secret);
}
# Fix bugs in Net::Amazon::Glacier 0.15
if (version->parse($Net::Amazon::Glacier::VERSION) <= version->parse('0.15')) {
no strict 'refs';
*{__PACKAGE__.'::list_vaults'} = \&list_vaults_fixed;
*{__PACKAGE__.'::get_vault_notifications'} = \&get_vault_notifications_fixed;
}
sub _eval {
my $self = shift;
my $method = shift;
my $wantarray = wantarray;
my $ret = http_catch(sub {
$wantarray ? [ $self->${\$method}(@_) ]
: $self->${\$method}(@_)
},
err => \my %err,
args => \@_);
if (keys(%err)) {
$self->{_last_http_err} = \%err;
} else {
$self->{_last_http_err} = undef;
}
return (wantarray && ref($ret) eq 'ARRAY') ? @$ret : $ret;
}
sub lasterr {
my ($self, $key) = @_;
return undef unless defined $self->{_last_http_err};
return 1 unless defined $key;
return $self->{_last_http_err}{$key};
}
sub last_error_message {
my ($self) = @_;
return "No error" unless $self->lasterr;
return $self->lasterr('mesg') || $self->lasterr('text');
}
# list_vaults_fixed
# A fixed version of Net::Amazon::Glacier::list_vaults. This version correctly
# formats the query string in accordance with the specification[1].
# The bug (along with the fix) was reported on December 15, 2018[2].
# Hopefully it will be fixed in further versions of Net::Amazon::Glacier.
# Until then, the initialization code above overrides installs this method
# as list_vaults, if Net::Amazon::Glacier version 0.15 is in use.
#
# [1] https://docs.aws.amazon.com/amazonglacier/latest/dev/api-vaults-get.html
# [2] https://rt.cpan.org/Public/Bug/Display.html?id=128029
sub list_vaults_fixed {
my ($self) = @_;
my @vaults;
# print "using fixed list_vaults\n";
my $marker;
do {
#10 is the default limit, send a marker if needed
my $res = $self->_send_receive(
GET => "/-/vaults?limit=10" . ($marker ? '&marker='.$marker : '')
);
# updated error severity
croak 'list_vaults failed with error ' . $res->status_line unless $res->is_success;
my $decoded = $self->_decode_and_handle_response( $res );
push @vaults, @{$decoded->{VaultList}};
$marker = $decoded->{Marker};
} while ( $marker );
return ( \@vaults );
}
# get_vault_notifications_fixed
# A fixed version of Net::Amazon::Glacier::get_vault_notifications.
# Fixes the use of HTTP method[1].
#
# The bug (along with the fix) was reported on December 15, 2018[2].
# Hopefully it will be fixed in further versions of Net::Amazon::Glacier.
# Until then, the initialization code above overrides installs this method
# as get_vault_notifications, if Net::Amazon::Glacier version 0.15 is in use.
#
# [1] https://docs.aws.amazon.com/amazonglacier/latest/dev/api-vault-notifications-get.html
# [2] https://rt.cpan.org/Public/Bug/Display.html?id=128028
sub get_vault_notifications_fixed {
my ($self, $vault_name, $sns_topic, $events) = @_;
croak "no vault name given" unless $vault_name;
my $res = $self->_send_receive(
GET => "/-/vaults/$vault_name/notification-configuration",
);
# updated error severity
croak 'get_vault_notifications failed with error ' . $res->status_line
unless $res->is_success;
return $self->_decode_and_handle_response( $res );
}
our $AUTOLOAD;
sub AUTOLOAD {
my $self = shift;
(my $meth = $AUTOLOAD) =~ s/.*:://;
if ($meth =~ s/^([A-Z])(.*)/\L$1\E$2/) {
return $self->_eval($meth, @_);
}
croak "unknown method $AUTOLOAD";
}
1;
|
