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] ) } ? 1 : 0;
23 my ( $attr, $reader, $writer ) = @_;
25 my ( $instance, $predicate ) = @_;
26 foreach my $val ( @{ $reader->($instance) } ) {
27 return $val if $predicate->($val);
34 my ( $attr, $reader, $writer ) = @_;
36 my ( $instance, $f ) = @_;
37 CORE::map { $f->($_) } @{ $reader->($instance) };
42 my ( $attr, $reader, $writer ) = @_;
44 my ( $instance, $predicate ) = @_;
45 die "Argument must be a code reference"
46 if $predicate && ref $predicate ne 'CODE';
49 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
52 CORE::sort @{ $reader->($instance) };
58 my ( $attr, $reader, $writer ) = @_;
60 my ( $instance, $predicate ) = @_;
61 CORE::grep { $predicate->($_) } @{ $reader->($instance) };
65 sub elements : method {
66 my ( $attr, $reader, $writer ) = @_;
69 @{ $reader->($instance) };
74 my ( $attr, $reader, $writer ) = @_;
76 my ( $instance, $separator ) = @_;
77 join $separator, @{ $reader->($instance) };
82 my ( $attr, $reader, $writer ) = @_;
84 $reader->( $_[0] )->[0];
89 my ( $attr, $reader, $writer ) = @_;
91 $reader->( $_[0] )->[-1];
96 my ( $attr, $reader, $writer ) = @_;
99 $attr->has_type_constraint
100 && $attr->type_constraint->isa(
101 'Moose::Meta::TypeConstraint::Parameterized')
103 my $container_type_constraint
104 = $attr->type_constraint->type_parameter;
106 my $instance = CORE::shift;
107 $container_type_constraint->check($_)
110 . " did not pass container type constraint '$container_type_constraint'"
112 CORE::push @{ $reader->($instance) } => @_;
117 my $instance = CORE::shift;
118 CORE::push @{ $reader->($instance) } => @_;
124 my ( $attr, $reader, $writer ) = @_;
126 CORE::pop @{ $reader->( $_[0] ) };
130 sub unshift : method {
131 my ( $attr, $reader, $writer ) = @_;
133 $attr->has_type_constraint
134 && $attr->type_constraint->isa(
135 'Moose::Meta::TypeConstraint::Parameterized')
137 my $container_type_constraint
138 = $attr->type_constraint->type_parameter;
140 my $instance = CORE::shift;
141 $container_type_constraint->check($_)
144 . " did not pass container type constraint '$container_type_constraint'"
146 CORE::unshift @{ $reader->($instance) } => @_;
151 my $instance = CORE::shift;
152 CORE::unshift @{ $reader->($instance) } => @_;
158 my ( $attr, $reader, $writer ) = @_;
160 CORE::shift @{ $reader->( $_[0] ) };
165 my ( $attr, $reader, $writer ) = @_;
167 $reader->( $_[0] )->[ $_[1] ];
172 my ( $attr, $reader, $writer ) = @_;
174 $attr->has_type_constraint
175 && $attr->type_constraint->isa(
176 'Moose::Meta::TypeConstraint::Parameterized')
178 my $container_type_constraint
179 = $attr->type_constraint->type_parameter;
181 ( $container_type_constraint->check( $_[2] ) )
183 . ( $_[2] || 'undef' )
184 . " did not pass container type constraint '$container_type_constraint'";
185 $reader->( $_[0] )->[ $_[1] ] = $_[2];
190 $reader->( $_[0] )->[ $_[1] ] = $_[2];
195 sub accessor : method {
196 my ( $attr, $reader, $writer ) = @_;
199 $attr->has_type_constraint
200 && $attr->type_constraint->isa(
201 'Moose::Meta::TypeConstraint::Parameterized')
203 my $container_type_constraint
204 = $attr->type_constraint->type_parameter;
208 if ( @_ == 1 ) { # reader
209 return $reader->($self)->[ $_[0] ];
211 elsif ( @_ == 2 ) { # writer
212 ( $container_type_constraint->check( $_[1] ) )
214 . ( $_[1] || 'undef' )
215 . " did not pass container type constraint '$container_type_constraint'";
216 $reader->($self)->[ $_[0] ] = $_[1];
219 confess "One or two arguments expected, not " . @_;
227 if ( @_ == 1 ) { # reader
228 return $reader->($self)->[ $_[0] ];
230 elsif ( @_ == 2 ) { # writer
231 $reader->($self)->[ $_[0] ] = $_[1];
234 confess "One or two arguments expected, not " . @_;
241 my ( $attr, $reader, $writer ) = @_;
243 @{ $reader->( $_[0] ) } = ();
247 sub delete : method {
248 my ( $attr, $reader, $writer ) = @_;
250 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
254 sub insert : method {
255 my ( $attr, $reader, $writer ) = @_;
257 $attr->has_type_constraint
258 && $attr->type_constraint->isa(
259 'Moose::Meta::TypeConstraint::Parameterized')
261 my $container_type_constraint
262 = $attr->type_constraint->type_parameter;
264 ( $container_type_constraint->check( $_[2] ) )
266 . ( $_[2] || 'undef' )
267 . " did not pass container type constraint '$container_type_constraint'";
268 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
273 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
278 sub splice : method {
279 my ( $attr, $reader, $writer ) = @_;
281 $attr->has_type_constraint
282 && $attr->type_constraint->isa(
283 'Moose::Meta::TypeConstraint::Parameterized')
285 my $container_type_constraint
286 = $attr->type_constraint->type_parameter;
288 my ( $self, $i, $j, @elems ) = @_;
289 ( $container_type_constraint->check($_) )
291 . ( defined($_) ? $_ : 'undef' )
292 . " did not pass container type constraint '$container_type_constraint'"
294 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
299 my ( $self, $i, $j, @elems ) = @_;
300 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
305 sub sort_in_place : method {
306 my ( $attr, $reader, $writer ) = @_;
308 my ( $instance, $predicate ) = @_;
310 die "Argument must be a code reference"
311 if $predicate && ref $predicate ne 'CODE';
315 @sorted = CORE::sort { $predicate->( $a, $b ) }
316 @{ $reader->($instance) };
319 @sorted = CORE::sort @{ $reader->($instance) };
322 $writer->( $instance, \@sorted );
334 Moose::Meta::Attribute::Native::MethodProvider::Array
340 use Moose::AttributeHelpers;
343 metaclass => 'Array',
345 isa => 'ArrayRef[Str]',
346 default => sub { [] },
349 all_options => 'elements',
350 map_options => 'map',
351 filter_options => 'grep',
352 find_option => 'find',
353 first_option => 'first',
354 last_option => 'last',
356 join_options => 'join',
357 count_options => 'count',
358 do_i_have_options => 'empty',
359 sorted_options => 'sort',
368 This is a role which provides the method generators for
369 L<Moose::Meta::Attribute::Trait::Native::Array>.
379 =head1 PROVIDED METHODS
385 Returns the number of elements in the array.
388 $stuff->options(["foo", "bar", "baz", "boo"]);
390 my $count = $stuff->count_options;
391 print "$count\n"; # prints 4
395 If the array is populated, returns true. Otherwise, returns false.
397 $stuff->do_i_have_options ? print "Good boy.\n" : die "No options!\n" ;
401 This method accepts a subroutine reference as its argument. That sub
402 will receive each element of the array in turn. If it returns true for
403 an element, that element will be returned by the C<find> method.
405 my $found = $stuff->find_option( sub { $_[0] =~ /^b/ } );
406 print "$found\n"; # prints "bar"
410 This method accepts a subroutine reference as its argument. This
411 method returns every element for which that subroutine reference
412 returns a true value.
414 my @found = $stuff->filter_options( sub { $_[0] =~ /^b/ } );
415 print "@found\n"; # prints "bar baz boo"
419 This method accepts a subroutine reference as its argument. The
420 subroutine will be executed for each element of the array. It is
421 expected to return a modified version of that element. The return
422 value of the method is a list of the modified options.
424 my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } );
425 print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag"
429 Sorts and returns the elements of the array.
431 You can provide an optional subroutine reference to sort with (as you
432 can with the core C<sort> function). However, instead of using C<$a>
433 and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead.
435 # ascending ASCIIbetical
436 my @sorted = $stuff->sort_options();
438 # Descending alphabetical order
439 my @sorted_options = $stuff->sort_options( sub { lc $_[1] cmp lc $_[0] } );
440 print "@sorted_options\n"; # prints "foo boo baz bar"
444 Returns all of the elements of the array
446 my @option = $stuff->all_options;
447 print "@options\n"; # prints "foo bar baz boo"
451 Joins every element of the array using the separator given as argument.
453 my $joined = $stuff->join_options( ':' );
454 print "$joined\n"; # prints "foo:bar:baz:boo"
458 Returns an element of the array by its index.
460 my $option = $stuff->get_option(1);
461 print "$option\n"; # prints "bar"
465 Returns the first element of the array.
467 my $first = $stuff->first_option;
468 print "$first\n"; # prints "foo"
472 Returns the last element of the array.
474 my $last = $stuff->last_option;
475 print "$last\n"; # prints "boo"
495 =item B<sort_in_place>
497 Sorts the array I<in place>, modifying the value of the attribute.
499 You can provide an optional subroutine reference to sort with (as you
500 can with the core C<sort> function). However, instead of using C<$a>
501 and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead.
505 If passed one argument, returns the value of the requested element.
506 If passed two arguments, sets the value of the requested element.
512 All complex software has bugs lurking in it, and this module is no
513 exception. If you find a bug please either email me, or add the bug
518 Stevan Little E<lt>stevan@iinteractive.comE<gt>
520 =head1 COPYRIGHT AND LICENSE
522 Copyright 2007-2009 by Infinity Interactive, Inc.
524 L<http://www.iinteractive.com>
526 This library is free software; you can redistribute it and/or modify
527 it under the same terms as Perl itself.