1 package Moose::Meta::Attribute::Native::MethodProvider::Array;
8 $VERSION = eval $VERSION;
9 our $AUTHORITY = 'cpan:STEVAN';
12 my ( $attr, $reader, $writer ) = @_;
14 scalar @{ $reader->( $_[0] ) };
18 sub is_empty : method {
19 my ( $attr, $reader, $writer ) = @_;
21 scalar @{ $reader->( $_[0] ) } ? 0 : 1;
26 my ( $attr, $reader, $writer ) = @_;
28 my ( $instance, $predicate ) = @_;
29 List::Util::first { $predicate->() } @{ $reader->($instance) };
34 my ( $attr, $reader, $writer ) = @_;
36 my ( $instance, $f ) = @_;
37 CORE::map { $f->() } @{ $reader->($instance) };
42 my ( $attr, $reader, $writer ) = @_;
44 my ( $instance, $f ) = @_;
46 List::Util::reduce { $f->($a, $b) } @{ $reader->($instance) };
51 my ( $attr, $reader, $writer ) = @_;
53 my ( $instance, $predicate ) = @_;
54 die "Argument must be a code reference"
55 if $predicate && ref $predicate ne 'CODE';
58 # Although it would be nice if we could support just using $a and
59 # $b like sort already does, using $a or $b once in a package
60 # triggers the 'Name "main::a" used only once' warning, and there
61 # is no good way to avoid that, since it happens when the file
62 # which defines the coderef is compiled, before we even get a
63 # chance to see it here. So, we have no real choice but to use
64 # normal parameters. --doy
65 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
68 CORE::sort @{ $reader->($instance) };
73 sub shuffle : method {
74 my ( $attr, $reader, $writer ) = @_;
76 my ( $instance ) = @_;
77 List::Util::shuffle @{ $reader->($instance) };
82 my ( $attr, $reader, $writer ) = @_;
84 my ( $instance, $predicate ) = @_;
85 CORE::grep { $predicate->() } @{ $reader->($instance) };
90 my ( $attr, $reader, $writer ) = @_;
92 my ( $instance ) = @_;
93 List::MoreUtils::uniq @{ $reader->($instance) };
97 sub elements : method {
98 my ( $attr, $reader, $writer ) = @_;
101 @{ $reader->($instance) };
106 my ( $attr, $reader, $writer ) = @_;
108 my ( $instance, $separator ) = @_;
109 join $separator, @{ $reader->($instance) };
114 my ( $attr, $reader, $writer ) = @_;
117 $attr->has_type_constraint
118 && $attr->type_constraint->isa(
119 'Moose::Meta::TypeConstraint::Parameterized')
122 my $container_type_constraint = $attr->type_constraint->type_parameter;
124 my $instance = CORE::shift;
125 $container_type_constraint->check($_)
128 . " did not pass container type constraint '$container_type_constraint'"
130 CORE::push @{ $reader->($instance) } => @_;
135 my $instance = CORE::shift;
136 CORE::push @{ $reader->($instance) } => @_;
142 my ( $attr, $reader, $writer ) = @_;
144 CORE::pop @{ $reader->( $_[0] ) };
148 sub unshift : method {
149 my ( $attr, $reader, $writer ) = @_;
151 $attr->has_type_constraint
152 && $attr->type_constraint->isa(
153 'Moose::Meta::TypeConstraint::Parameterized')
156 my $container_type_constraint = $attr->type_constraint->type_parameter;
158 my $instance = CORE::shift;
159 $container_type_constraint->check($_)
162 . " did not pass container type constraint '$container_type_constraint'"
164 CORE::unshift @{ $reader->($instance) } => @_;
169 my $instance = CORE::shift;
170 CORE::unshift @{ $reader->($instance) } => @_;
176 my ( $attr, $reader, $writer ) = @_;
178 CORE::shift @{ $reader->( $_[0] ) };
183 my ( $attr, $reader, $writer ) = @_;
185 $reader->( $_[0] )->[ $_[1] ];
190 my ( $attr, $reader, $writer ) = @_;
192 $attr->has_type_constraint
193 && $attr->type_constraint->isa(
194 'Moose::Meta::TypeConstraint::Parameterized')
197 my $container_type_constraint = $attr->type_constraint->type_parameter;
199 ( $container_type_constraint->check( $_[2] ) )
201 . ( $_[2] || 'undef' )
202 . " did not pass container type constraint '$container_type_constraint'";
203 $reader->( $_[0] )->[ $_[1] ] = $_[2];
208 $reader->( $_[0] )->[ $_[1] ] = $_[2];
213 sub accessor : method {
214 my ( $attr, $reader, $writer ) = @_;
217 $attr->has_type_constraint
218 && $attr->type_constraint->isa(
219 'Moose::Meta::TypeConstraint::Parameterized')
222 my $container_type_constraint = $attr->type_constraint->type_parameter;
226 if ( @_ == 1 ) { # reader
227 return $reader->($self)->[ $_[0] ];
229 elsif ( @_ == 2 ) { # writer
230 ( $container_type_constraint->check( $_[1] ) )
232 . ( $_[1] || 'undef' )
233 . " did not pass container type constraint '$container_type_constraint'";
234 $reader->($self)->[ $_[0] ] = $_[1];
237 confess "One or two arguments expected, not " . @_;
245 if ( @_ == 1 ) { # reader
246 return $reader->($self)->[ $_[0] ];
248 elsif ( @_ == 2 ) { # writer
249 $reader->($self)->[ $_[0] ] = $_[1];
252 confess "One or two arguments expected, not " . @_;
259 my ( $attr, $reader, $writer ) = @_;
261 @{ $reader->( $_[0] ) } = ();
265 sub delete : method {
266 my ( $attr, $reader, $writer ) = @_;
268 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
272 sub insert : 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 ( $container_type_constraint->check( $_[2] ) )
284 . ( $_[2] || 'undef' )
285 . " did not pass container type constraint '$container_type_constraint'";
286 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
291 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
296 sub splice : method {
297 my ( $attr, $reader, $writer ) = @_;
299 $attr->has_type_constraint
300 && $attr->type_constraint->isa(
301 'Moose::Meta::TypeConstraint::Parameterized')
304 my $container_type_constraint = $attr->type_constraint->type_parameter;
306 my ( $self, $i, $j, @elems ) = @_;
307 ( $container_type_constraint->check($_) )
309 . ( defined($_) ? $_ : 'undef' )
310 . " did not pass container type constraint '$container_type_constraint'"
312 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
317 my ( $self, $i, $j, @elems ) = @_;
318 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
323 sub sort_in_place : method {
324 my ( $attr, $reader, $writer ) = @_;
326 my ( $instance, $predicate ) = @_;
328 die "Argument must be a code reference"
329 if $predicate && ref $predicate ne 'CODE';
334 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
337 @sorted = CORE::sort @{ $reader->($instance) };
340 $writer->( $instance, \@sorted );
344 sub natatime : method {
345 my ( $attr, $reader, $writer ) = @_;
347 my ( $instance, $n, $f ) = @_;
348 my $it = List::MoreUtils::natatime($n, @{ $reader->($instance) });
350 while (my @vals = $it->()) {
366 Moose::Meta::Attribute::Native::MethodProvider::Array - role providing method generators for Array trait
370 This is a role which provides the method generators for
371 L<Moose::Meta::Attribute::Native::Trait::Array>. Please check there for
372 documentation on what methods are provided.
384 See L<Moose/BUGS> for details on reporting bugs.
388 Stevan Little E<lt>stevan@iinteractive.comE<gt>
390 =head1 COPYRIGHT AND LICENSE
392 Copyright 2007-2009 by Infinity Interactive, Inc.
394 L<http://www.iinteractive.com>
396 This library is free software; you can redistribute it and/or modify
397 it under the same terms as Perl itself.