File Coverage

blib/lib/Net/Amazon/S3/Utils.pm
Criterion Covered Total %
statement 30 30 100.0
branch 15 16 93.7
condition 6 6 100.0
subroutine 4 4 100.0
pod 0 4 0.0
total 55 60 91.6


line stmt bran cond sub pod time code
1             package Net::Amazon::S3::Utils;
2             # ABSTRACT: misc utils
3             $Net::Amazon::S3::Utils::VERSION = '0.99';
4             sub parse_arguments {
5 206     206 0 3173 my ($self, $arguments, $positional, $aliases) = @_;
6 206         387 my %args;
7 206 100       647 $aliases = {} unless $aliases;
8              
9 206 100 100     1271 push @$arguments, %{ pop @$arguments }
  95         490  
10             if @$arguments && Ref::Util::is_plain_hashref ($arguments->[-1]);
11              
12 206         1315 my %positional = map +($_ => 1), grep ! exists $args{$_}, @$positional;
13 206         660 my $positional_count = scalar keys %positional;
14 206   100     1171 while (@$arguments > 1 && @$arguments > $positional_count) {
15 471         1080 my ($name, $value) = splice @$arguments, -2, 2;
16              
17 471 100       1034 next if exists $args{$name};
18              
19 470         894 $args{$name} = $value;
20              
21 470 100       1040 $name = $aliases->{$name} if exists $aliases->{$name};
22              
23 470 100       1491 if (exists $positional{$name}) {
24 155         266 $positional_count--;
25 155         527 delete $positional{$name};
26             }
27             }
28              
29             #die "Odd number of named arguments"
30             # if @$arguments != $positional_count;
31              
32 206         800 for my $key (keys %$aliases) {
33 141 100       519 next unless exists $args{$key};
34 2         6 my $value = delete $args{$key};
35 2         5 my $alias_for = $aliases->{$key};
36 2 50       8 $args{$alias_for} = $value unless exists $args{$alias_for};
37             }
38              
39 206         511 for my $name (@$positional) {
40 291 100       804 next if exists $args{$name};
41 136         373 $args{$name} = shift @$arguments;
42             }
43              
44 206         1313 return %args;
45             }
46              
47             sub parse_arguments_with_bucket {
48 59     59 0 5746 my ($self, $arguments) = @_;
49              
50 59         299 return $self->parse_arguments ($arguments, [qw[ bucket ]], { name => 'bucket' });
51             }
52              
53             sub parse_arguments_with_bucket_and_object {
54 7     7 0 4689 my ($self, $arguments) = @_;
55              
56 7         48 return $self->parse_arguments ($arguments, [qw[ bucket key ]], { name => 'bucket' });
57             }
58              
59             sub parse_arguments_with_object {
60 74     74 0 4843 my ($self, $arguments) = @_;
61              
62 74         440 return $self->parse_arguments ($arguments, [qw[ key ]], { name => 'bucket' });
63             }
64              
65             1;
66              
67             __END__
68              
69             =pod
70              
71             =encoding UTF-8
72              
73             =head1 NAME
74              
75             Net::Amazon::S3::Utils - misc utils
76              
77             =head1 VERSION
78              
79             version 0.99
80              
81             =head1 AUTHOR
82              
83             Branislav Zahradník <barney@cpan.org>
84              
85             =head1 COPYRIGHT AND LICENSE
86              
87             This software is copyright (c) 2021 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover, Branislav Zahradník.
88              
89             This is free software; you can redistribute it and/or modify it under
90             the same terms as the Perl 5 programming language system itself.
91              
92             =cut