foo
[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider / Array.pm
CommitLineData
b9dc8e2f 1package MooseX::AttributeHelpers::MethodProvider::Array;
2use Moose::Role;
3
4sub 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
24sub pop : method {
25 my ($attr) = @_;
26 return sub {
27 CORE::pop @{$attr->get_value($_[0])}
28 };
29}
30
31sub 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
51sub shift : method {
52 my ($attr) = @_;
53 return sub {
54 CORE::shift @{$attr->get_value($_[0])}
55 };
56}
57
58sub get : method {
59 my ($attr) = @_;
60 return sub {
61 $attr->get_value($_[0])->[$_[1]]
62 };
63}
64
65sub 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
82sub count : method {
83 my ($attr) = @_;
84 return sub {
85 scalar @{$attr->get_value($_[0])}
86 };
87}
88
89sub empty : method {
90 my ($attr) = @_;
91 return sub {
92 scalar @{$attr->get_value($_[0])} ? 1 : 0
93 };
94}
95
96sub 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
0e744400 107sub map : method {
108 my ($attr) = @_;
109 return sub {
110 my ($instance, $f) = @_;
111 CORE::map { $f->($_) } @{$attr->get_value($instance)}
112 };
113}
114
115sub grep : method {
116 my ($attr) = @_;
117 return sub {
118 my ($instance, $predicate) = @_;
119 CORE::grep { $predicate->($_) } @{$attr->get_value($instance)}
120 };
121}
122
b9dc8e2f 1231;
124
125__END__
126
127=pod
128
129=cut