Lots of files got moved around,a nd some got added.

[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider / Collection / Array.pm

package MooseX::AttributeHelpers::MethodProvider::Collection::Array;
use MooseX::AttributeHelpers::MethodProvider;
use MooseX::AttributeHelpers::MethodProvider::Util qw(type_check);
use MooseX::AttributeHelpers::MethodProvider::Collection::List;

our $VERSION   = '0.05';
our $AUTHORITY = 'cpan:STEVAN';

add_method_provider 'Collection::Array' => (
    type     => 'ArrayRef',
    consumes => { 'Collection::List' => ':all' },
    provides => {
        push => sub {
            my ($attr, $reader, $writer) = @_;
            return type_check($attr, sub {@_[1,$#_]}, sub {
                my $self = shift;
                CORE::push(@{ $reader->($self) }, @_);
            });
        },

        pop => sub {
            my ($attr, $reader, $writer) = @_;
            return sub { CORE::pop(@{ $reader->($_[0]) }) };
        },

        unshift => sub {
            my ($attr, $reader, $writer) = @_;
            return type_check($attr, sub {@_[1,$#_]}, sub {
                my $self = shift;
                CORE::unshift(@{ $reader->($self) }, @_);
            });
        },

        shift => sub {
            my ($attr, $reader, $writer) = @_;
            return sub {
                CORE::shift(@{ $reader->($_[0]) });
            };
        },

        get => sub {
            my ($attr, $reader, $writer) = @_;
            return sub {
                my $self = shift;
                return @{ $reader->($self) }[@_];
            };
        },

        set => sub {
            my ($attr, $reader, $writer) = @_;
            return type_check($attr, sub {@_[2,$#_]}, sub {
                my ($self, $index, @values) = @_;
                my @indexes = (ref $index eq 'ARRAY' ? @$index : ($index));
                @{ $reader->($self) }[@indexes] = @values;
            });
        },

        clear => sub {
            my ($attr, $reader, $writer) = @_;
            return sub { @{ $reader->($_[0]) } = () };
        },

        delete => sub {
            my ($attr, $reader, $writer) = @_;
            return sub {
                CORE::splice(@{ $reader->($_[0]) }, $_[1], $_[2] || 1);
            };
        },

        insert => sub {
            my ($attr, $reader, $writer) = @_;
            return type_contraint($attr, sub {@_[2,$#_]}, sub {
                my ($self, $index, @values) = @_;
                CORE::splice(@{ $reader->($self) }, $index, 0, @values);
            });
        },
    },
);

1;

__END__

=pod

=head1 NAME

MooseX::AttributeHelpers::MethodProvider::Array

=head1 DESCRIPTION

This is a role which provides the method generators for
L<MooseX::AttributeHelpers::Collection::Array>.

=head1 PROVIDED METHODS

This module consumes L<MooseX::AttributeHelpers::MethodProvider::List>, and so
provides all of its methods as well.  All methods work when multiple indexes
are supplied - special cases are noted.

=over 4

=item B<get(@indexes)>

Behaves just like indexing an arrayref: returns the items indexed by the
supplied arguments (i.e. C<$self-&gt;get_my_stuff(1,2,3)> means
C<@{$aref}[1,2,3]>).

=item B<set($index, $value)>

=item B<set([$indexes], @values)>

This is just like assigning to an arrayref, except that an arrayref lets you
assign multiple indexes at once with no strange syntax.  You can do that with
this set as well, but the first argument should be an arrayref of the keys you
want to assign to.  (e.g. C<$self-&gt;set_aref([1,2,3], qw(foo bar baz))>)

=item B<pop>

L<perlfunc/pop>

=item B<push($item)>

L<perlfunc/push>

=item B<shift>

L<perlfunc/shift>

=item B<unshift($item)>

L<perlfunc/unshift>

=item B<clear>

Deletes all items from the array.

=item B<delete($index, $length)>

Deletes $length (default: 1) items from the array at $index.

=item B<insert($index, @items)>

Inserts @items into list at $index.

=back

=head1 BUGS

All complex software has bugs lurking in it, and this module is no
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2007-2008 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut