lib/MooseX/AttributeHelpers/MethodProvider/Array.pm

   1 package MooseX::AttributeHelpers::MethodProvider::Array;
   2 use Moose::Role;
   3
   4 sub push : method {
   5     my ($attr) = @_;
   6     if ($attr->has_container_type) {
   7         my $container_type_constraint = $attr->container_type_constraint;
   8         return sub {
   9             my $instance = CORE::shift;
  10             $container_type_constraint->check($_)
  11                 || confess "Value " . ($_||'undef') . " did not pass container type constraint"
  12                     foreach @_;
  13             CORE::push @{$attr->get_value($instance)} => @_;
  14         };
  15     }
  16     else {
  17         return sub {
  18             my $instance = CORE::shift;
  19             CORE::push @{$attr->get_value($instance)} => @_;
  20         };
  21     }
  22 }
  23
  24 sub pop : method {
  25     my ($attr) = @_;
  26     return sub {
  27         CORE::pop @{$attr->get_value($_[0])}
  28     };
  29 }
  30
  31 sub unshift : method {
  32     my ($attr) = @_;
  33     if ($attr->has_container_type) {
  34         my $container_type_constraint = $attr->container_type_constraint;
  35         return sub {
  36             my $instance = CORE::shift;
  37             $container_type_constraint->check($_)
  38                 || confess "Value " . ($_||'undef') . " did not pass container type constraint"
  39                     foreach @_;
  40             CORE::unshift @{$attr->get_value($instance)} => @_;
  41         };
  42     }
  43     else {
  44         return sub {
  45             my $instance = CORE::shift;
  46             CORE::unshift @{$attr->get_value($instance)} => @_;
  47         };
  48     }
  49 }
  50
  51 sub shift : method {
  52     my ($attr) = @_;
  53     return sub {
  54         CORE::shift @{$attr->get_value($_[0])}
  55     };
  56 }
  57
  58 sub get : method {
  59     my ($attr) = @_;
  60     return sub {
  61         $attr->get_value($_[0])->[$_[1]]
  62     };
  63 }
  64
  65 sub set : method {
  66     my ($attr) = @_;
  67     if ($attr->has_container_type) {
  68         my $container_type_constraint = $attr->container_type_constraint;
  69         return sub {
  70             ($container_type_constraint->check($_[2]))
  71                 || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
  72             $attr->get_value($_[0])->[$_[1]] = $_[2]
  73         };
  74     }
  75     else {
  76         return sub {
  77             $attr->get_value($_[0])->[$_[1]] = $_[2]
  78         };
  79     }
  80 }
  81
  82 sub count : method {
  83     my ($attr) = @_;
  84     return sub {
  85         scalar @{$attr->get_value($_[0])}
  86     };
  87 }
  88
  89 sub empty : method {
  90     my ($attr) = @_;
  91     return sub {
  92         scalar @{$attr->get_value($_[0])} ? 1 : 0
  93     };
  94 }
  95
  96 sub find : method {
  97     my ($attr) = @_;
  98     return sub {
  99         my ($instance, $predicate) = @_;
 100         foreach my $val (@{$attr->get_value($instance)}) {
 101             return $val if $predicate->($val);
 102         }
 103         return;
 104     };
 105 }
 106
 107 1;
 108
 109 __END__
 110
 111 =pod
 112
 113 =cut