1 package MooseX::AttributeHelpers::MethodProvider::Array;
5 $VERSION = eval $VERSION;
6 our $AUTHORITY = 'cpan:STEVAN';
8 with 'MooseX::AttributeHelpers::MethodProvider::List';
11 my ($attr, $reader, $writer) = @_;
13 if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
14 my $container_type_constraint = $attr->type_constraint->type_parameter;
16 my $instance = CORE::shift;
17 $container_type_constraint->check($_)
18 || confess "Value " . ($_||'undef') . " did not pass container type constraint"
20 CORE::push @{$reader->($instance)} => @_;
25 my $instance = CORE::shift;
26 CORE::push @{$reader->($instance)} => @_;
32 my ($attr, $reader, $writer) = @_;
34 CORE::pop @{$reader->($_[0])}
38 sub unshift : method {
39 my ($attr, $reader, $writer) = @_;
40 if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
41 my $container_type_constraint = $attr->type_constraint->type_parameter;
43 my $instance = CORE::shift;
44 $container_type_constraint->check($_)
45 || confess "Value " . ($_||'undef') . " did not pass container type constraint"
47 CORE::unshift @{$reader->($instance)} => @_;
52 my $instance = CORE::shift;
53 CORE::unshift @{$reader->($instance)} => @_;
59 my ($attr, $reader, $writer) = @_;
61 CORE::shift @{$reader->($_[0])}
66 my ($attr, $reader, $writer) = @_;
68 $reader->($_[0])->[$_[1]]
73 my ($attr, $reader, $writer) = @_;
74 if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
75 my $container_type_constraint = $attr->type_constraint->type_parameter;
77 ($container_type_constraint->check($_[2]))
78 || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
79 $reader->($_[0])->[$_[1]] = $_[2]
84 $reader->($_[0])->[$_[1]] = $_[2]
90 my ($attr, $reader, $writer) = @_;
92 @{$reader->($_[0])} = ()
97 my ($attr, $reader, $writer) = @_;
99 CORE::splice @{$reader->($_[0])}, $_[1], 1;
103 sub insert : method {
104 my ($attr, $reader, $writer) = @_;
105 if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
106 my $container_type_constraint = $attr->type_constraint->type_parameter;
108 ($container_type_constraint->check($_[2]))
109 || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
110 CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2];
115 CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2];
120 sub splice : method {
121 my ($attr, $reader, $writer) = @_;
122 if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
123 my $container_type_constraint = $attr->type_constraint->type_parameter;
125 my ( $self, $i, $j, @elems ) = @_;
126 ($container_type_constraint->check($_))
127 || confess "Value " . (defined($_) ? $_ : 'undef') . " did not pass container type constraint" for @elems;
128 CORE::splice @{$reader->($self)}, $i, $j, @elems;
133 my ( $self, $i, $j, @elems ) = @_;
134 CORE::splice @{$reader->($self)}, $i, $j, @elems;
139 sub sort_in_place : method {
140 my ($attr, $reader, $writer) = @_;
142 my ($instance, $predicate) = @_;
144 die "Argument must be a code reference"
145 if $predicate && ref $predicate ne 'CODE';
149 @sorted = CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
152 @sorted = CORE::sort @{$reader->($instance)};
155 $writer->($instance, \@sorted);
167 MooseX::AttributeHelpers::MethodProvider::Array
171 This is a role which provides the method generators for
172 L<MooseX::AttributeHelpers::Collection::Array>.
182 =head1 PROVIDED METHODS
184 This module also consumes the B<List> method providers, to
185 see those provied methods, refer to that documentation.
209 =item B<sort_in_place>
211 Sorts the array I<in place>, modifying the value of the attribute.
213 You can provide an optional subroutine reference to sort with (as you
214 can with the core C<sort> function). However, instead of using C<$a>
215 and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead.
221 All complex software has bugs lurking in it, and this module is no
222 exception. If you find a bug please either email me, or add the bug
227 Stevan Little E<lt>stevan@iinteractive.comE<gt>
229 =head1 COPYRIGHT AND LICENSE
231 Copyright 2007-2008 by Infinity Interactive, Inc.
233 L<http://www.iinteractive.com>
235 This library is free software; you can redistribute it and/or modify
236 it under the same terms as Perl itself.