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.98';
4             sub parse_arguments {
5 205     205 0 3987 my ($self, $arguments, $positional, $aliases) = @_;
6 205         373 my %args;
7 205 100       613 $aliases = {} unless $aliases;
8              
9 205 100 100     1242 push @$arguments, %{ pop @$arguments }
  94         429  
10             if @$arguments && Ref::Util::is_plain_hashref ($arguments->[-1]);
11              
12 205         1257 my %positional = map +($_ => 1), grep ! exists $args{$_}, @$positional;
13 205         543 my $positional_count = scalar keys %positional;
14 205   100     1007 while (@$arguments > 1 && @$arguments > $positional_count) {
15 470         1059 my ($name, $value) = splice @$arguments, -2, 2;
16              
17 470 100       999 next if exists $args{$name};
18              
19 469         849 $args{$name} = $value;
20              
21 469 100       915 $name = $aliases->{$name} if exists $aliases->{$name};
22              
23 469 100       1402 if (exists $positional{$name}) {
24 155         245 $positional_count--;
25 155         545 delete $positional{$name};
26             }
27             }
28              
29             #die "Odd number of named arguments"
30             # if @$arguments != $positional_count;
31              
32 205         713 for my $key (keys %$aliases) {
33 141 100       520 next unless exists $args{$key};
34 2         5 my $value = delete $args{$key};
35 2         17 my $alias_for = $aliases->{$key};
36 2 50       10 $args{$alias_for} = $value unless exists $args{$alias_for};
37             }
38              
39 205         516 for my $name (@$positional) {
40 288 100       782 next if exists $args{$name};
41 133         348 $args{$name} = shift @$arguments;
42             }
43              
44 205         1239 return %args;
45             }
46              
47             sub parse_arguments_with_bucket {
48 59     59 0 6011 my ($self, $arguments) = @_;
49              
50 59         308 return $self->parse_arguments ($arguments, [qw[ bucket ]], { name => 'bucket' });
51             }
52              
53             sub parse_arguments_with_bucket_and_object {
54 7     7 0 5053 my ($self, $arguments) = @_;
55              
56 7         40 return $self->parse_arguments ($arguments, [qw[ bucket key ]], { name => 'bucket' });
57             }
58              
59             sub parse_arguments_with_object {
60 74     74 0 5138 my ($self, $arguments) = @_;
61              
62 74         503 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.98
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