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] ) };
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 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
53 CORE::sort @{ $reader->($instance) };
59 my ( $attr, $reader, $writer ) = @_;
61 my ( $instance, $predicate ) = @_;
62 CORE::grep { $predicate->() } @{ $reader->($instance) };
66 sub elements : method {
67 my ( $attr, $reader, $writer ) = @_;
70 @{ $reader->($instance) };
75 my ( $attr, $reader, $writer ) = @_;
77 my ( $instance, $separator ) = @_;
78 join $separator, @{ $reader->($instance) };
83 my ( $attr, $reader, $writer ) = @_;
85 $reader->( $_[0] )->[0];
90 my ( $attr, $reader, $writer ) = @_;
92 my $arr = $reader->( $_[0] );
93 return @{ $arr }[1..$#{ $arr }];
98 my ( $attr, $reader, $writer ) = @_;
100 $reader->( $_[0] )->[-1];
105 my ( $attr, $reader, $writer ) = @_;
108 $attr->has_type_constraint
109 && $attr->type_constraint->isa(
110 'Moose::Meta::TypeConstraint::Parameterized')
113 my $container_type_constraint = $attr->type_constraint->type_parameter;
115 my $instance = CORE::shift;
116 $container_type_constraint->check($_)
119 . " did not pass container type constraint '$container_type_constraint'"
121 CORE::push @{ $reader->($instance) } => @_;
126 my $instance = CORE::shift;
127 CORE::push @{ $reader->($instance) } => @_;
133 my ( $attr, $reader, $writer ) = @_;
135 CORE::pop @{ $reader->( $_[0] ) };
139 sub unshift : method {
140 my ( $attr, $reader, $writer ) = @_;
142 $attr->has_type_constraint
143 && $attr->type_constraint->isa(
144 'Moose::Meta::TypeConstraint::Parameterized')
147 my $container_type_constraint = $attr->type_constraint->type_parameter;
149 my $instance = CORE::shift;
150 $container_type_constraint->check($_)
153 . " did not pass container type constraint '$container_type_constraint'"
155 CORE::unshift @{ $reader->($instance) } => @_;
160 my $instance = CORE::shift;
161 CORE::unshift @{ $reader->($instance) } => @_;
167 my ( $attr, $reader, $writer ) = @_;
169 CORE::shift @{ $reader->( $_[0] ) };
174 my ( $attr, $reader, $writer ) = @_;
176 $reader->( $_[0] )->[ $_[1] ];
181 my ( $attr, $reader, $writer ) = @_;
183 $attr->has_type_constraint
184 && $attr->type_constraint->isa(
185 'Moose::Meta::TypeConstraint::Parameterized')
188 my $container_type_constraint = $attr->type_constraint->type_parameter;
190 ( $container_type_constraint->check( $_[2] ) )
192 . ( $_[2] || 'undef' )
193 . " did not pass container type constraint '$container_type_constraint'";
194 $reader->( $_[0] )->[ $_[1] ] = $_[2];
199 $reader->( $_[0] )->[ $_[1] ] = $_[2];
204 sub accessor : method {
205 my ( $attr, $reader, $writer ) = @_;
208 $attr->has_type_constraint
209 && $attr->type_constraint->isa(
210 'Moose::Meta::TypeConstraint::Parameterized')
213 my $container_type_constraint = $attr->type_constraint->type_parameter;
217 if ( @_ == 1 ) { # reader
218 return $reader->($self)->[ $_[0] ];
220 elsif ( @_ == 2 ) { # writer
221 ( $container_type_constraint->check( $_[1] ) )
223 . ( $_[1] || 'undef' )
224 . " did not pass container type constraint '$container_type_constraint'";
225 $reader->($self)->[ $_[0] ] = $_[1];
228 confess "One or two arguments expected, not " . @_;
236 if ( @_ == 1 ) { # reader
237 return $reader->($self)->[ $_[0] ];
239 elsif ( @_ == 2 ) { # writer
240 $reader->($self)->[ $_[0] ] = $_[1];
243 confess "One or two arguments expected, not " . @_;
250 my ( $attr, $reader, $writer ) = @_;
252 @{ $reader->( $_[0] ) } = ();
256 sub delete : method {
257 my ( $attr, $reader, $writer ) = @_;
259 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
263 sub insert : method {
264 my ( $attr, $reader, $writer ) = @_;
266 $attr->has_type_constraint
267 && $attr->type_constraint->isa(
268 'Moose::Meta::TypeConstraint::Parameterized')
271 my $container_type_constraint = $attr->type_constraint->type_parameter;
273 ( $container_type_constraint->check( $_[2] ) )
275 . ( $_[2] || 'undef' )
276 . " did not pass container type constraint '$container_type_constraint'";
277 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
282 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
287 sub splice : method {
288 my ( $attr, $reader, $writer ) = @_;
290 $attr->has_type_constraint
291 && $attr->type_constraint->isa(
292 'Moose::Meta::TypeConstraint::Parameterized')
295 my $container_type_constraint = $attr->type_constraint->type_parameter;
297 my ( $self, $i, $j, @elems ) = @_;
298 ( $container_type_constraint->check($_) )
300 . ( defined($_) ? $_ : 'undef' )
301 . " did not pass container type constraint '$container_type_constraint'"
303 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
308 my ( $self, $i, $j, @elems ) = @_;
309 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
314 sub sort_in_place : method {
315 my ( $attr, $reader, $writer ) = @_;
317 my ( $instance, $predicate ) = @_;
319 die "Argument must be a code reference"
320 if $predicate && ref $predicate ne 'CODE';
325 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
328 @sorted = CORE::sort @{ $reader->($instance) };
331 $writer->( $instance, \@sorted );
343 Moose::Meta::Attribute::Native::MethodProvider::Array
347 This is a role which provides the method generators for
348 L<Moose::Meta::Attribute::Trait::Native::Array>. Please check there for
349 documentation on what methods are provided.
361 All complex software has bugs lurking in it, and this module is no
362 exception. If you find a bug please either email me, or add the bug
367 Stevan Little E<lt>stevan@iinteractive.comE<gt>
369 =head1 COPYRIGHT AND LICENSE
371 Copyright 2007-2009 by Infinity Interactive, Inc.
373 L<http://www.iinteractive.com>
375 This library is free software; you can redistribute it and/or modify
376 it under the same terms as Perl itself.