lib/MooseX/AttributeHelpers/MethodProvider/Array.pm

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