lib/MooseX/AttributeHelpers/MethodProvider/Collection/Array.pm

   1 package MooseX::AttributeHelpers::MethodProvider::Collection::Array;
   2 use MooseX::AttributeHelpers::MethodProvider;
   3 use MooseX::AttributeHelpers::MethodProvider::Util qw(type_check);
   4 use MooseX::AttributeHelpers::MethodProvider::Collection::List;
   5
   6 our $VERSION   = '0.05';
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   9 add_method_provider 'Collection::Array' => (
  10     type     => 'ArrayRef',
  11     consumes => { 'Collection::List' => ':all' },
  12     provides => {
  13         push => sub {
  14             my ($attr, $reader, $writer) = @_;
  15             return type_check($attr, sub {@_[1,$#_]}, sub {
  16                 my $self = shift;
  17                 CORE::push(@{ $reader->($self) }, @_);
  18             });
  19         },
  20
  21         pop => sub {
  22             my ($attr, $reader, $writer) = @_;
  23             return sub { CORE::pop(@{ $reader->($_[0]) }) };
  24         },
  25
  26         unshift => sub {
  27             my ($attr, $reader, $writer) = @_;
  28             return type_check($attr, sub {@_[1,$#_]}, sub {
  29                 my $self = shift;
  30                 CORE::unshift(@{ $reader->($self) }, @_);
  31             });
  32         },
  33
  34         shift => sub {
  35             my ($attr, $reader, $writer) = @_;
  36             return sub {
  37                 CORE::shift(@{ $reader->($_[0]) });
  38             };
  39         },
  40
  41         get => sub {
  42             my ($attr, $reader, $writer) = @_;
  43             return sub {
  44                 my $self = shift;
  45                 return @{ $reader->($self) }[@_];
  46             };
  47         },
  48
  49         set => sub {
  50             my ($attr, $reader, $writer) = @_;
  51             return type_check($attr, sub {@_[2,$#_]}, sub {
  52                 my ($self, $index, @values) = @_;
  53                 my @indexes = (ref $index eq 'ARRAY' ? @$index : ($index));
  54                 @{ $reader->($self) }[@indexes] = @values;
  55             });
  56         },
  57
  58         clear => sub {
  59             my ($attr, $reader, $writer) = @_;
  60             return sub { @{ $reader->($_[0]) } = () };
  61         },
  62
  63         delete => sub {
  64             my ($attr, $reader, $writer) = @_;
  65             return sub {
  66                 CORE::splice(@{ $reader->($_[0]) }, $_[1], $_[2] || 1);
  67             };
  68         },
  69
  70         insert => sub {
  71             my ($attr, $reader, $writer) = @_;
  72             return type_contraint($attr, sub {@_[2,$#_]}, sub {
  73                 my ($self, $index, @values) = @_;
  74                 CORE::splice(@{ $reader->($self) }, $index, 0, @values);
  75             });
  76         },
  77     },
  78 );
  79
  80 1;
  81
  82 __END__
  83
  84 =pod
  85
  86 =head1 NAME
  87
  88 MooseX::AttributeHelpers::MethodProvider::Array
  89
  90 =head1 DESCRIPTION
  91
  92 This is a role which provides the method generators for
  93 L<MooseX::AttributeHelpers::Collection::Array>.
  94
  95 =head1 PROVIDED METHODS
  96
  97 This module consumes L<MooseX::AttributeHelpers::MethodProvider::List>, and so
  98 provides all of its methods as well.  All methods work when multiple indexes
  99 are supplied - special cases are noted.
 100
 101 =over 4
 102
 103 =item B<get(@indexes)>
 104
 105 Behaves just like indexing an arrayref: returns the items indexed by the
 106 supplied arguments (i.e. C<$self-&gt;get_my_stuff(1,2,3)> means
 107 C<@{$aref}[1,2,3]>).
 108
 109 =item B<set($index, $value)>
 110
 111 =item B<set([$indexes], @values)>
 112
 113 This is just like assigning to an arrayref, except that an arrayref lets you
 114 assign multiple indexes at once with no strange syntax.  You can do that with
 115 this set as well, but the first argument should be an arrayref of the keys you
 116 want to assign to.  (e.g. C<$self-&gt;set_aref([1,2,3], qw(foo bar baz))>)
 117
 118 =item B<pop>
 119
 120 L<perlfunc/pop>
 121
 122 =item B<push($item)>
 123
 124 L<perlfunc/push>
 125
 126 =item B<shift>
 127
 128 L<perlfunc/shift>
 129
 130 =item B<unshift($item)>
 131
 132 L<perlfunc/unshift>
 133
 134 =item B<clear>
 135
 136 Deletes all items from the array.
 137
 138 =item B<delete($index, $length)>
 139
 140 Deletes $length (default: 1) items from the array at $index.
 141
 142 =item B<insert($index, @items)>
 143
 144 Inserts @items into list at $index.
 145
 146 =back
 147
 148 =head1 BUGS
 149
 150 All complex software has bugs lurking in it, and this module is no
 151 exception. If you find a bug please either email me, or add the bug
 152 to cpan-RT.
 153
 154 =head1 AUTHOR
 155
 156 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 157
 158 =head1 COPYRIGHT AND LICENSE
 159
 160 Copyright 2007-2008 by Infinity Interactive, Inc.
 161
 162 L<http://www.iinteractive.com>
 163
 164 This library is free software; you can redistribute it and/or modify
 165 it under the same terms as Perl itself.
 166
 167 =cut