File Coverage

blib/lib/Net/Amazon/S3/ACL.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package Net::Amazon::S3::ACL;

use warnings;
use strict;
use version; our $VERSION = qv('0.1.0');

use Carp;
use English qw( -no_match_vars );
use Net::Amazon::S3::ACL::XMLHelper qw( xpc );
use Net::Amazon::S3::ACL::Grant;
use Scalar::Util qw( blessed );

use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw( owner_id owner_displayname grants ));

# Module implementation here
sub new {
   my $class = shift;

   my $params = shift || {};
   my $xml    = delete $params->{xml};
   my $self   = $class->SUPER::new($params);

   $self->parse($xml) if defined $xml;
   $self->grants({}) unless $self->grants();

   return $self;
} ## end sub new

sub parse {
   my ($self, $xml) = @_;
   my $xpc = xpc($xml);

   $self->owner_id($xpc->findvalue('//s3:Owner/s3:ID'));
   $self->owner_displayname($xpc->findvalue('//s3:Owner/s3:DisplayName'));

   my %grants = map {
      my $grant = Net::Amazon::S3::ACL::Grant->create(
         {
            xpc => $xpc,
            node => $_,
         }
      );
      ($grant->key() => $grant);
   } $xpc->findnodes('.//s3:AccessControlList/s3:Grant');
   $self->grants(\%grants);

   return $self;
} ## end sub parse

sub delete {
   my $self = shift;
   if (@_ == 1 && blessed($_[0])) {
      $self->_delete(undef, @_);
      return $self;
   }

   my @grants = ref $_[0] ? %{$_[0]} : @_;
   while (my ($target, $item) = splice @grants, 0, 2) {
      $self->_delete($target, $item);
   }
   return $self;
}

sub _delete {
   my $self = shift;
   my $item = Net::Amazon::S3::ACL::Grant->canonical(@_);
   #use Data::Dumper; warn Dumper $item;
   my $target = $item->key();

   my $grants = $self->grants() or return;
   my $perms = $item->{permissions} || [];
   if (scalar(@$perms)) {
      my $previous = $grants->{$target} or return;
      my %forbidden = map { $_ => 1 } @$perms;
      $previous->{permissions} =
        [grep { !$forbidden{$_} } @{$previous->{permissions} || []}];
      delete $grants->{$target} unless @{$previous->{permissions}};
   } ## end if (defined($item->{permissions...
   else {
      #use Data::Dumper; warn Dumper($grants, \$target);
      delete $grants->{$target};
   }
   return;
} ## end sub _delete

sub add {
   my $self = shift;
   if (@_ == 1 && blessed($_[0])) {
      $self->_add(undef, @_);
      return $self;
   }

   my @grants = ref $_[0] ? %{$_[0]} : @_;
   while (my ($target, $item) = splice @grants, 0, 2) {
      $self->_add($target, $item);
   }
   return $self;
} ## end sub add

sub _add {
   my $self = shift;
   my $item = Net::Amazon::S3::ACL::Grant->canonical(@_);
   #use Data::Dumper; warn Dumper $item;
   my $target = $item->key();

   my $grants = $self->grants();
   $self->grants($grants = {}) unless $grants;

   my $previous = $grants->{$target} ||= $item;
   my %flag;    # to filter out duplicates
   $previous->{permissions} = [
      grep { !$flag{$_}++ } @{$previous->{permissions} || []},
      @{$item->{permissions} || []}
   ];

   delete $grants->{$target} unless @{$previous->{permissions}};
   return;
} ## end sub _add

sub stringify {
   my $self = shift;

   my $owner_chunk  = $self->_stringify_owner();
   my $grants_chunk = $self->_stringify_grants();

   # Indent for pretty printing
   s/^/   /mxsg for $owner_chunk, $grants_chunk;

   return <<"END_OF_ACL";


$owner_chunk$grants_chunk

END_OF_ACL
} ## end sub stringify

sub _stringify_owner {
   my ($self) = @_;

   defined(my $owner_id = $self->owner_id()) or return '';
   my $owner_displayname = $self->owner_displayname();
   $owner_displayname = '' unless defined $owner_displayname;

   return <<"END_OF_OWNER";

   $owner_id
   $owner_displayname

END_OF_OWNER
} ## end sub _stringify_owner

sub _stringify_grants {
   my ($self) = @_;

   my $list = join "\n",
     map { $_->stringify(); }
     grep { $_->is_valid()}
     values %{$self->grants()};

   $list =~ s/^/   /mxsg;    # indented
   return "\n$list\n";
} ## end sub _stringify_acl

sub dump {
   my $self = shift;

   eval {
      require YAML;
      return YAML::Dump({
         grants => $self->grants(),
         owner  => {
            id => $self->owner_id(),
            displayname => $self->owner_displayname(),
         },
      });
   } or return $self->stringify();
}

1; # Magic true value required at end of module
__END__