File Coverage

blib/lib/Net/Amazon/S3/ACL/Set.pm
Criterion Covered Total %
statement 59 64 92.1
branch 8 14 57.1
condition 2 2 100.0
subroutine 14 16 87.5
pod 5 6 83.3
total 88 102 86.2


line stmt bran cond sub pod time code
1             # ABSTRACT: Representation of explicit ACL
2             $Net::Amazon::S3::ACL::Set::VERSION = '0.991';
3             use Moose 0.85;
4 100     100   1186 use MooseX::StrictConstructor 0.16;
  100         1628  
  100         566  
5 100     100   531003 use Moose::Util::TypeConstraints;
  100         1488  
  100         567  
6 100     100   261614  
  100         236  
  100         628  
7             use Ref::Util ();
8 100     100   176302 use Safe::Isa ();
  100         222  
  100         1652  
9 100     100   478  
  100         189  
  100         1937  
10             use Net::Amazon::S3::Constants;
11 100     100   33769 use Net::Amazon::S3::ACL::Grantee::User;
  100         230  
  100         2596  
12 100     100   37577 use Net::Amazon::S3::ACL::Grantee::Group;
  100         263  
  100         2920  
13 100     100   40152 use Net::Amazon::S3::ACL::Grantee::Email;
  100         292  
  100         3096  
14 100     100   39402  
  100         289  
  100         53624  
15             class_type 'Net::Amazon::S3::ACL::Set';
16              
17             my %permission_map = (
18             full_control => Net::Amazon::S3::Constants::HEADER_GRANT_FULL_CONTROL,
19             read => Net::Amazon::S3::Constants::HEADER_GRANT_READ,
20             read_acp => Net::Amazon::S3::Constants::HEADER_GRANT_READ_ACP,
21             write => Net::Amazon::S3::Constants::HEADER_GRANT_WRITE,
22             write_acp => Net::Amazon::S3::Constants::HEADER_GRANT_WRITE_ACP,
23             );
24              
25             my %grantees_map = (
26             id => 'Net::Amazon::S3::ACL::Grantee::User',
27             user => 'Net::Amazon::S3::ACL::Grantee::User',
28             uri => 'Net::Amazon::S3::ACL::Grantee::Group',
29             group => 'Net::Amazon::S3::ACL::Grantee::Group',
30             email => 'Net::Amazon::S3::ACL::Grantee::Email',
31             );
32              
33             has _grantees => (
34             is => 'ro',
35             default => sub { +{} },
36             );
37              
38             my ($self) = @_;
39              
40 30     30 0 80 my %headers;
41             while (my ($header, $grantees) = each %{ $self->_grantees }) {
42 30         54 $headers{$header} = join ', ', map $_->format_for_header, @$grantees;
43 30         61 }
  91         2054  
44 61         230  
45             %headers;
46             }
47 30         252  
48             my ($self, @grantees) = @_;
49              
50             $self->_grant (full_control => @grantees);
51 1     1 1 225 }
52              
53 1         4 my ($self, @grantees) = @_;
54              
55             $self->_grant (read => @grantees);
56             }
57 15     15 1 4126  
58             my ($self, @grantees) = @_;
59 15         74  
60             $self->_grant (read_acp => @grantees);
61             }
62              
63 0     0 1 0 my ($self, @grantees) = @_;
64              
65 0         0 $self->_grant (write => @grantees);
66             }
67              
68             my ($self, @grantees) = @_;
69 16     16 1 456  
70             $self->_grant (write_acp => @grantees);
71 16         56 }
72              
73             my ($self, $permission, @grantees) = @_;
74             $self = $self->new unless ref $self;
75 0     0 1 0  
76             my $key = lc $permission;
77 0         0 $key =~ tr/-/_/;
78              
79             die "Unknown permission $permission"
80             unless exists $permission_map{$key};
81 32     32   96  
82 32 50       100 return unless @grantees;
83              
84 32         72 my $list = $self->_grantees->{$permission_map{$key}} ||= [];
85 32         60 while (@grantees) {
86             my $type = shift @grantees;
87              
88 32 50       114 if ($type->$Safe::Isa::_isa ('Net::Amazon::S3::ACL::Grantee')) {
89             push @{ $list }, $type;
90 32 50       79 next;
91             }
92 32   100     847  
93 32         92 die "Unknown grantee type $type"
94 49         7711 unless exists $grantees_map{$type};
95              
96 49 100       160 die "Grantee type $type requires one argument"
97 2         23 unless @grantees;
  2         3  
98 2         5  
99             my @grantee = (shift @grantees);
100             @grantees = @{ $grantee[0] }
101             if Ref::Util::is_plain_arrayref ($grantee[0]);
102 47 50       460  
103             push @{ $list }, map $grantees_map{$type}->new ($_), @grantee;
104 47 50       110 }
105              
106             return $self;
107 47         93 }
108 47 50       150  
  0         0  
109             1;
110              
111 47         68  
  47         353  
112             =pod
113              
114 32         12828 =encoding UTF-8
115              
116             =head1 NAME
117              
118             Net::Amazon::S3::ACL::Set - Representation of explicit ACL
119              
120             =head1 VERSION
121              
122             version 0.991
123              
124             =head1 SYNOPSIS
125              
126             use Net::Amazon::S3::ACL;
127              
128             $acl = Net::Amazon::S3::ACL->new
129             ->grant_full_control (
130             id => 11112222333,
131             id => 444455556666,
132             uri => 'predefined group uri',
133             email => 'email-address',
134             )
135             ->grant_write (
136             ...
137             )
138             ;
139              
140             =head1 DESCRIPTION
141              
142             Class representing explicit Amazon S3 ACL configuration.
143              
144             =head1 METHODS
145              
146             =head2 new
147              
148             Creates new instance.
149              
150             =head2 grant_full_control (@grantees)
151              
152             =head2 grant_read (@grantees)
153              
154             =head2 grant_read_acp (@grantees)
155              
156             =head2 grant_write (@grantees)
157              
158             =head2 grant_write_acp (@grantees)
159              
160             =head1 GRANTEES
161              
162             See also L<"Who Is a Grantee?"|https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#specifying-grantee>
163             in Amazon S3 documentation.
164              
165             Each grant_* method accepts list of grantees either in key-value format or as an
166             instance of C<Net::Amazon::S3::ACL::Grantee::*>.
167              
168             =over
169              
170             =item canonical user ID
171              
172             ->grant_read (
173             id => 123,
174             Net::Amazon::S3::ACL::Grantee::User->new (123),
175             )
176              
177             =item predefined group uri
178              
179             ->grant_read (
180             uri => 'http://...',
181             Net::Amazon::S3::ACL::Grantee::Group->new ('http://...'),
182             Net::Amazon::S3::ACL::Grantee::Group->ALL_USERS,
183             )
184              
185             =item email address
186              
187             ->grant_read (
188             email => 'foo@bar.baz',
189             Net::Amazon::S3::ACL::Grantee::Email->new ('foo@bar.baz'),
190             );
191              
192             =back
193              
194             =head1 AUTHOR
195              
196             Branislav Zahradník <barney@cpan.org>
197              
198             =head1 COPYRIGHT AND LICENSE
199              
200             This module is part of L<Net::Amazon::S3>.
201              
202             =head1 AUTHOR
203              
204             Branislav Zahradník <barney@cpan.org>
205              
206             =head1 COPYRIGHT AND LICENSE
207              
208             This software is copyright (c) 2022 by Amazon Digital Services, Leon Brocard, Brad Fitzpatrick, Pedro Figueiredo, Rusty Conover, Branislav Zahradník.
209              
210             This is free software; you can redistribute it and/or modify it under
211             the same terms as the Perl 5 programming language system itself.
212              
213             =cut