File Coverage

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

Criterion	Covered	Total	%
statement	19	92	20.6
branch	0	30	0.0
condition	0	16	0.0
subroutine	7	16	43.7
pod	9	9	100.0
total	35	163	21.4

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

use warnings;
use strict;
use Carp;
use English qw( -no_match_vars );
use Scalar::Util qw( blessed );

use base qw(Class::Accessor::Fast);
__PACKAGE__->mk_accessors(qw( key permissions ));

our @Classes;
BEGIN {
   @Classes = qw( Email URI ID );
}

# Module implementation here
sub new {
   my $package = shift;
   my $params = shift || {};

   my $self = $package->SUPER::new($params);
   if ($params->{xpc} && $params->{node}) {
      $self->parse($params->{xpc}, $params->{node});
   }
   elsif ($params->{target}) {
      $self->populate_from_target($params->{target});
   }

   $self->_set_key();

   my $permissions = $self->permissions();
   $self->permissions([]);
   $self->add_permissions($permissions) if $permissions;

   return $self;
} ## end sub new

my %permission_normalisation_for = (
   WRITE        => 'WRITE',
   W            => 'WRITE',
   '>'          => 'WRITE',
   READ         => 'READ',
   R            => 'READ',
   '<'          => 'READ',
   FULL_CONTROL => 'FULL_CONTROL',
   'FULL-CONTROL' => 'FULL_CONTROL',
   FULL         => 'FULL_CONTROL',
   F            => 'FULL_CONTROL',
   '*'          => 'FULL_CONTROL',
   'WRITE_ACP'  => 'WRITE_ACP',
   'WP'         => 'WRITE_ACP',
   'WRITE-ACP'  => 'WRITE_ACP',
   'READ_ACP'   => 'READ_ACP',
   'RP'         => 'READ_ACP',
   'READ-ACP'   => 'READ_ACP',
);

sub add_permissions {
   my $self = shift;

   my @input = grep {defined} ref($_[0]) ? @{$_[0]} : @_;
   my @permissions = @{$self->permissions()};
   for my $new_perm (@input) {
      $new_perm = uc $new_perm;
      croak "unknown permission $new_perm"
         unless exists $permission_normalisation_for{$new_perm};
      push @permissions, $permission_normalisation_for{$new_perm};
   }

   my %flag;
   @permissions = grep { ! $flag{$_}++ } @permissions;
   $self->permissions(\@permissions);

   return $self;
}

sub delete_permissions {
   my $self = shift;

   my @input = ref($_[0]) ? @{$_[0]} : @_;
   my %flag = map {
      croak "unknown permission $_"
         unless exists $permission_normalisation_for{$_};
      $permission_normalisation_for{$_} => 1;
   } @input;

   my @permissions = grep { ! $flag{$_}++ } @{$self->permissions()};
   $self->permissions(\@permissions);

   return $self;
}

sub is_valid { return scalar(@{$_[0]->permissions()}) > 0; }

sub class_for {
   my ($package, $name) = @_;
   $package = ref($package) || $package;
   return join '::', $package, $name;
}

sub create {
   my $package = shift;
   my $params = shift || {};

   croak "not enough parameters to create a grant"
      unless ($params->{xpc} && $params->{node})
         || $params->{target};

   for my $type (@Classes) {
      my $class = $package->class_for($type);

      my $sub_new = $class->can('new');
      if (! $sub_new) {
         eval "require $class" or die "no package $class available";
         $sub_new = $class->can('new')
            or die "package $class does not support 'new'";
      }

      my $self;
      $self = eval { $class->$sub_new($params) }
         and return $self;
   }

   require Data::Dumper;
   croak 'no suitable subclass found to handle input data: ',
      Data::Dumper::Dumper($params);
} ## end sub new


sub canonical {
   my ($pack, $target, $item) = @_;

   return $item if blessed $item;

   $target = $target->key() if blessed $target;
   $item = $pack->create(
      {
         target => $target,
         permissions => $item,
      }
   );

   return $item;
}

sub parse {
   my ($self, $xpc, $node) = @_;
   $self->parse_grantee($xpc, $node);
   my @permissions =
      map { $_->to_literal() } $xpc->findnodes('.//s3:Permission', $node);
   $self->permissions(\@permissions);
   return $self;
}

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

   return '' unless $self->is_valid();

   (my $grantee = $self->stringify_grantee()) =~ s/^/   /mxsg;
   return join "\n", map {
      ;
      "\n$grantee   $_\n";
   } @{$self->permissions()};
}

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