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 # 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 ) = @_;
92 $reader->( $_[0] )->[0];
97 my ( $attr, $reader, $writer ) = @_;
99 my $arr = $reader->( $_[0] );
100 return @{ $arr }[1..$#{ $arr }];
105 my ( $attr, $reader, $writer ) = @_;
107 $reader->( $_[0] )->[-1];
112 my ( $attr, $reader, $writer ) = @_;
115 $attr->has_type_constraint
116 && $attr->type_constraint->isa(
117 'Moose::Meta::TypeConstraint::Parameterized')
120 my $container_type_constraint = $attr->type_constraint->type_parameter;
122 my $instance = CORE::shift;
123 $container_type_constraint->check($_)
126 . " did not pass container type constraint '$container_type_constraint'"
128 CORE::push @{ $reader->($instance) } => @_;
133 my $instance = CORE::shift;
134 CORE::push @{ $reader->($instance) } => @_;
140 my ( $attr, $reader, $writer ) = @_;
142 CORE::pop @{ $reader->( $_[0] ) };
146 sub unshift : method {
147 my ( $attr, $reader, $writer ) = @_;
149 $attr->has_type_constraint
150 && $attr->type_constraint->isa(
151 'Moose::Meta::TypeConstraint::Parameterized')
154 my $container_type_constraint = $attr->type_constraint->type_parameter;
156 my $instance = CORE::shift;
157 $container_type_constraint->check($_)
160 . " did not pass container type constraint '$container_type_constraint'"
162 CORE::unshift @{ $reader->($instance) } => @_;
167 my $instance = CORE::shift;
168 CORE::unshift @{ $reader->($instance) } => @_;
174 my ( $attr, $reader, $writer ) = @_;
176 CORE::shift @{ $reader->( $_[0] ) };
181 my ( $attr, $reader, $writer ) = @_;
183 $reader->( $_[0] )->[ $_[1] ];
188 my ( $attr, $reader, $writer ) = @_;
190 $attr->has_type_constraint
191 && $attr->type_constraint->isa(
192 'Moose::Meta::TypeConstraint::Parameterized')
195 my $container_type_constraint = $attr->type_constraint->type_parameter;
197 ( $container_type_constraint->check( $_[2] ) )
199 . ( $_[2] || 'undef' )
200 . " did not pass container type constraint '$container_type_constraint'";
201 $reader->( $_[0] )->[ $_[1] ] = $_[2];
206 $reader->( $_[0] )->[ $_[1] ] = $_[2];
211 sub accessor : method {
212 my ( $attr, $reader, $writer ) = @_;
215 $attr->has_type_constraint
216 && $attr->type_constraint->isa(
217 'Moose::Meta::TypeConstraint::Parameterized')
220 my $container_type_constraint = $attr->type_constraint->type_parameter;
224 if ( @_ == 1 ) { # reader
225 return $reader->($self)->[ $_[0] ];
227 elsif ( @_ == 2 ) { # writer
228 ( $container_type_constraint->check( $_[1] ) )
230 . ( $_[1] || 'undef' )
231 . " did not pass container type constraint '$container_type_constraint'";
232 $reader->($self)->[ $_[0] ] = $_[1];
235 confess "One or two arguments expected, not " . @_;
243 if ( @_ == 1 ) { # reader
244 return $reader->($self)->[ $_[0] ];
246 elsif ( @_ == 2 ) { # writer
247 $reader->($self)->[ $_[0] ] = $_[1];
250 confess "One or two arguments expected, not " . @_;
257 my ( $attr, $reader, $writer ) = @_;
259 @{ $reader->( $_[0] ) } = ();
263 sub delete : method {
264 my ( $attr, $reader, $writer ) = @_;
266 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 1;
270 sub insert : method {
271 my ( $attr, $reader, $writer ) = @_;
273 $attr->has_type_constraint
274 && $attr->type_constraint->isa(
275 'Moose::Meta::TypeConstraint::Parameterized')
278 my $container_type_constraint = $attr->type_constraint->type_parameter;
280 ( $container_type_constraint->check( $_[2] ) )
282 . ( $_[2] || 'undef' )
283 . " did not pass container type constraint '$container_type_constraint'";
284 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
289 CORE::splice @{ $reader->( $_[0] ) }, $_[1], 0, $_[2];
294 sub splice : method {
295 my ( $attr, $reader, $writer ) = @_;
297 $attr->has_type_constraint
298 && $attr->type_constraint->isa(
299 'Moose::Meta::TypeConstraint::Parameterized')
302 my $container_type_constraint = $attr->type_constraint->type_parameter;
304 my ( $self, $i, $j, @elems ) = @_;
305 ( $container_type_constraint->check($_) )
307 . ( defined($_) ? $_ : 'undef' )
308 . " did not pass container type constraint '$container_type_constraint'"
310 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
315 my ( $self, $i, $j, @elems ) = @_;
316 CORE::splice @{ $reader->($self) }, $i, $j, @elems;
321 sub sort_in_place : method {
322 my ( $attr, $reader, $writer ) = @_;
324 my ( $instance, $predicate ) = @_;
326 die "Argument must be a code reference"
327 if $predicate && ref $predicate ne 'CODE';
332 CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
335 @sorted = CORE::sort @{ $reader->($instance) };
338 $writer->( $instance, \@sorted );
350 Moose::Meta::Attribute::Native::MethodProvider::Array
354 This is a role which provides the method generators for
355 L<Moose::Meta::Attribute::Trait::Native::Array>. Please check there for
356 documentation on what methods are provided.
368 All complex software has bugs lurking in it, and this module is no
369 exception. If you find a bug please either email me, or add the bug
374 Stevan Little E<lt>stevan@iinteractive.comE<gt>
376 =head1 COPYRIGHT AND LICENSE
378 Copyright 2007-2009 by Infinity Interactive, Inc.
380 L<http://www.iinteractive.com>
382 This library is free software; you can redistribute it and/or modify
383 it under the same terms as Perl itself.