Commit | Line | Data |
b9dc8e2f |
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 |