1 package Moose::Meta::Attribute::Native::MethodProvider::Array;
5 $VERSION = eval $VERSION;
6 our $AUTHORITY = 'cpan:STEVAN';
9 my ( $attr, $reader, $writer ) = @_;
11 scalar @{ $reader->( $_[0] ) };
15 sub is_empty : method {
16 my ( $attr, $reader, $writer ) = @_;
18 scalar @{ $reader->( $_[0] ) } ? 0 : 1;
23 my ( $attr, $reader, $writer ) = @_;
25 my ( $instance, $predicate ) = @_;
26 foreach my $val ( @{ $reader->($instance) } ) {
28 return $val if $predicate->();
35 my ( $attr, $reader, $writer ) = @_;
37 my ( $instance, $f ) = @_;
38 CORE::map { $f->() } @{ $reader->($instance) };
43 my ( $attr, $reader, $writer ) = @_;
45 my ( $instance, $predicate ) = @_;
46 die "Argument must be a code reference"
47 if $predicate && ref $predicate ne 'CODE';
50 # Although it would be nice if we could support just using $a and
51 # $b like sort already does, using $a or $b once in a package
52 # triggers the 'Name "main::a" used only once' warning, and there
53 # is no good way to avoid that, since it happens when the file
54 # which defines the coderef is compiled, before we even get a
55 # chance to see it here. So, we have no real choice but to use
56 # normal parameters. --doy
57 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
60 CORE::sort @{ $reader->($instance) };
66 my ( $attr, $reader, $writer ) = @_;
68 my ( $instance, $predicate ) = @_;
69 CORE::grep { $predicate->() } @{ $reader->($instance) };
73 sub elements : method {
74 my ( $attr, $reader, $writer ) = @_;
77 @{ $reader->($instance) };
82 my ( $attr, $reader, $writer ) = @_;
84 my ( $instance, $separator ) = @_;
85 join $separator, @{ $reader->($instance) };
90 my ( $attr, $reader, $writer ) = @_;
93 $attr->has_type_constraint
94 && $attr->type_constraint->isa(
95 'Moose::Meta::TypeConstraint::Parameterized')
98 my $container_type_constraint = $attr->type_constraint->type_parameter;
100 my $instance = CORE::shift;
101 $container_type_constraint->check($_)
104 . " did not pass container type constraint '$container_type_constraint'"
106 CORE::push @{ $reader->($instance) } => @_;
111 my $instance = CORE::shift;
112 CORE::push @{ $reader->($instance) } => @_;
118 my ( $attr, $reader, $writer ) = @_;
120 CORE::pop @{ $reader->( $_[0] ) };
124 sub unshift : method {
125 my ( $attr, $reader, $writer ) = @_;
127 $attr->has_type_constraint
128 && $attr->type_constraint->isa(
129 'Moose::Meta::TypeConstraint::Parameterized')
132 my $container_type_constraint = $attr->type_constraint->type_parameter;
134 my $instance = CORE::shift;
135 $container_type_constraint->check($_)
138 . " did not pass container type constraint '$container_type_constraint'"
140 CORE::unshift @{ $reader->($instance) } => @_;
145 my $instance = CORE::shift;
146 CORE::unshift @{ $reader->($instance) } => @_;
152 my ( $attr, $reader, $writer ) = @_;
154 CORE::shift @{ $reader->( $_[0] ) };
159 my ( $attr, $reader, $writer ) = @_;
161 $reader->( $_[0] )->[ $_[1] ];
166 my ( $attr, $reader, $writer ) = @_;
168 $attr->has_type_constraint
169 && $attr->type_constraint->isa(
170 'Moose::Meta::TypeConstraint::Parameterized')
173 my $container_type_constraint = $attr->type_constraint->type_parameter;
175 ( $container_type_constraint->check( $_[2] ) )
177 . ( $_[2] || 'undef' )
178 . " did not pass container type constraint '$container_type_constraint'";
179 $reader->( $_[0] )->[ $_[1] ] = $_[2];
184 $reader->( $_[0] )->[ $_[1] ] = $_[2];
189 sub accessor : method {
190 my ( $attr, $reader, $writer ) = @_;
193 $attr->has_type_constraint
194 && $attr->type_constraint->isa(
195 'Moose::Meta::TypeConstraint::Parameterized')
198 my $container_type_constraint = $attr->type_constraint->type_parameter;
202 if ( @_ == 1 ) { # reader
203 return $reader->($self)->[ $_[0] ];
205 elsif ( @_ == 2 ) { # writer
206 ( $container_type_constraint->check( $_[1] ) )
208 . ( $_[1] || 'undef' )
209 . " did not pass container type constraint '$container_type_constraint'";
210 $reader->($self)->[ $_[0] ] = $_[1];
213 confess "One or two arguments expected, not " . @_;
221 if ( @_ == 1 ) { # reader
222 return $reader->($self)->[ $_[0] ];
224 elsif ( @_ == 2 ) { # writer
225 $reader->($self)->[ $_[0] ] = $_[1];
228 confess "One or two arguments expected, not " . @_;
235 my ( $attr, $reader, $writer ) = @_;
237 @{ $reader->( $_[0] ) } = ();
241 sub delete : method {
242 my ( $attr, $reader, $writer ) = @_;
244 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
248 sub insert : method {
249 my ( $attr, $reader, $writer ) = @_;
251 $attr->has_type_constraint
252 && $attr->type_constraint->isa(
253 'Moose::Meta::TypeConstraint::Parameterized')
256 my $container_type_constraint = $attr->type_constraint->type_parameter;
258 ( $container_type_constraint->check( $_[2] ) )
260 . ( $_[2] || 'undef' )
261 . " did not pass container type constraint '$container_type_constraint'";
262 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
267 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
272 sub splice : method {
273 my ( $attr, $reader, $writer ) = @_;
275 $attr->has_type_constraint
276 && $attr->type_constraint->isa(
277 'Moose::Meta::TypeConstraint::Parameterized')
280 my $container_type_constraint = $attr->type_constraint->type_parameter;
282 my ( $self, $i, $j, @elems ) = @_;
283 ( $container_type_constraint->check($_) )
285 . ( defined($_) ? $_ : 'undef' )
286 . " did not pass container type constraint '$container_type_constraint'"
288 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
293 my ( $self, $i, $j, @elems ) = @_;
294 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
299 sub sort_in_place : method {
300 my ( $attr, $reader, $writer ) = @_;
302 my ( $instance, $predicate ) = @_;
304 die "Argument must be a code reference"
305 if $predicate && ref $predicate ne 'CODE';
310 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
313 @sorted = CORE::sort @{ $reader->($instance) };
316 $writer->( $instance, \@sorted );
328 Moose::Meta::Attribute::Native::MethodProvider::Array
332 This is a role which provides the method generators for
333 L<Moose::Meta::Attribute::Trait::Native::Array>. Please check there for
334 documentation on what methods are provided.
346 All complex software has bugs lurking in it, and this module is no
347 exception. If you find a bug please either email me, or add the bug
352 Stevan Little E<lt>stevan@iinteractive.comE<gt>
354 =head1 COPYRIGHT AND LICENSE
356 Copyright 2007-2009 by Infinity Interactive, Inc.
358 L<http://www.iinteractive.com>
360 This library is free software; you can redistribute it and/or modify
361 it under the same terms as Perl itself.