All unit tests passing with refactored stuff, documentation updated significantly.
[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider / Array.pm
index 7366081..5668623 100644 (file)
@@ -1,5 +1,6 @@
 package MooseX::AttributeHelpers::MethodProvider::Array;
 use Moose::Role;
+use MooseX::AttributeHelpers::Collection::TypeCheck;
 
 our $VERSION   = '0.05';
 our $AUTHORITY = 'cpan:STEVAN';
@@ -8,112 +9,67 @@ with 'MooseX::AttributeHelpers::MethodProvider::List';
 
 sub push : method {
     my ($attr, $reader, $writer) = @_;
-    
-    if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
-        my $container_type_constraint = $attr->type_constraint->type_parameter;
-        return sub { 
-            my $instance = CORE::shift;
-            $container_type_constraint->check($_) 
-                || confess "Value " . ($_||'undef') . " did not pass container type constraint"
-                    foreach @_;
-            CORE::push @{$reader->($instance)} => @_; 
-        };                    
-    }
-    else {
-        return sub { 
-            my $instance = CORE::shift;
-            CORE::push @{$reader->($instance)} => @_; 
-        };
-    }
+    return type_check($attr, sub {@_[1,$#_]}, sub {
+        my $self = shift;
+        CORE::push(@{ $reader->($self) }, @_);
+    });
 }
 
 sub pop : method {
     my ($attr, $reader, $writer) = @_;
-    return sub { 
-        CORE::pop @{$reader->($_[0])} 
-    };
+    return sub { CORE::pop(@{ $reader->($_[0]) }) };
 }
 
 sub unshift : method {
     my ($attr, $reader, $writer) = @_;
-    if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
-        my $container_type_constraint = $attr->type_constraint->type_parameter;
-        return sub { 
-            my $instance = CORE::shift;
-            $container_type_constraint->check($_) 
-                || confess "Value " . ($_||'undef') . " did not pass container type constraint"
-                    foreach @_;
-            CORE::unshift @{$reader->($instance)} => @_; 
-        };                    
-    }
-    else {                
-        return sub { 
-            my $instance = CORE::shift;
-            CORE::unshift @{$reader->($instance)} => @_; 
-        };
-    }
+    return type_check($attr, sub {@_[1,$#_]}, sub {
+        my $self = shift;
+        CORE::unshift(@{ $reader->($self) }, @_);
+    });
 }
 
 sub shift : method {
     my ($attr, $reader, $writer) = @_;
     return sub { 
-        CORE::shift @{$reader->($_[0])} 
+        CORE::shift(@{ $reader->($_[0]) });
     };
 }
    
 sub get : method {
     my ($attr, $reader, $writer) = @_;
     return sub { 
-        $reader->($_[0])->[$_[1]] 
+        my $self = shift;
+        return @{ $reader->($self) }[@_];
     };
 }
 
 sub set : method {
     my ($attr, $reader, $writer) = @_;
-    if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
-        my $container_type_constraint = $attr->type_constraint->type_parameter;
-        return sub { 
-            ($container_type_constraint->check($_[2])) 
-                || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
-            $reader->($_[0])->[$_[1]] = $_[2]
-        };                    
-    }
-    else {                
-        return sub { 
-            $reader->($_[0])->[$_[1]] = $_[2] 
-        };
-    }
+    return type_check($attr, sub {@_[2,$#_]}, sub {
+        my ($self, $index, @values) = @_;
+        my @indexes = (ref $index eq 'ARRAY' ? @$index : ($index));
+        @{ $reader->($self) }[@indexes] = @values;
+    });
 }
 
 sub clear : method {
     my ($attr, $reader, $writer) = @_;
-    return sub { 
-        @{$reader->($_[0])} = ()
-    };
+    return sub { @{ $reader->($_[0]) } = () };
 }
 
 sub delete : method {
     my ($attr, $reader, $writer) = @_;
     return sub {
-        CORE::splice @{$reader->($_[0])}, $_[1], 1;
-    }
+        CORE::splice(@{ $reader->($_[0]) }, $_[1], $_[2] || 1);
+    };
 }
 
 sub insert : method {
     my ($attr, $reader, $writer) = @_;
-    if ($attr->has_type_constraint && $attr->type_constraint->isa('Moose::Meta::TypeConstraint::Parameterized')) {
-        my $container_type_constraint = $attr->type_constraint->type_parameter;
-        return sub { 
-            ($container_type_constraint->check($_[2])) 
-                || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
-            CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2];
-        };                    
-    }
-    else {                
-        return sub { 
-            CORE::splice @{$reader->($_[0])}, $_[1], 0, $_[2];
-        };
-    }    
+    return type_contraint($attr, sub {@_[2,$#_]}, sub {
+        my ($self, $index, @values) = @_;
+        CORE::splice(@{ $reader->($self) }, $index, 0, @values);
+    });
 }
  
 1;
@@ -131,38 +87,56 @@ MooseX::AttributeHelpers::MethodProvider::Array
 This is a role which provides the method generators for 
 L<MooseX::AttributeHelpers::Collection::Array>.
 
-=head1 METHODS
+=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<meta>
+=item B<get(@indexes)>
 
-=back
+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]>).
 
-=head1 PROVIDED METHODS
+=item B<set($index, $value)>
 
-This module also consumes the B<List> method providers, to 
-see those provied methods, refer to that documentation.
+=item B<set([$indexes], @values)>
 
-=over 4
-
-=item B<get>
+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>
 
-=item B<push>
+L<perlfunc/pop>
 
-=item B<set>
+=item B<push($item)>
+
+L<perlfunc/push>
 
 =item B<shift>
 
-=item B<unshift>
+L<perlfunc/shift>
+
+=item B<unshift($item)>
+
+L<perlfunc/unshift>
 
 =item B<clear>
 
-=item B<delete>
+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)>
 
-=item B<insert>
+Inserts @items into list at $index.
 
 =back