lib/MooseX/AttributeHelpers/MethodProvider/Array.pm

   1 package MooseX::AttributeHelpers::MethodProvider::Array;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.03';
   5 our $AUTHORITY = 'cpan:STEVAN';
   6
   7 with 'MooseX::AttributeHelpers::MethodProvider::List';
   8
   9 sub push : method {
  10     my ($attr, $reader, $writer) = @_;
  11
  12     if ($attr->has_container_type) {
  13         my $container_type_constraint = $attr->container_type_constraint;
  14         return sub {
  15             my $instance = CORE::shift;
  16             $container_type_constraint->check($_)
  17                 || confess "Value " . ($_||'undef') . " did not pass container type constraint"
  18                     foreach @_;
  19             CORE::push @{$reader->($instance)} => @_;
  20         };
  21     }
  22     else {
  23         return sub {
  24             my $instance = CORE::shift;
  25             CORE::push @{$reader->($instance)} => @_;
  26         };
  27     }
  28 }
  29
  30 sub pop : method {
  31     my ($attr, $reader, $writer) = @_;
  32     return sub {
  33         CORE::pop @{$reader->($_[0])}
  34     };
  35 }
  36
  37 sub unshift : method {
  38     my ($attr, $reader, $writer) = @_;
  39     if ($attr->has_container_type) {
  40         my $container_type_constraint = $attr->container_type_constraint;
  41         return sub {
  42             my $instance = CORE::shift;
  43             $container_type_constraint->check($_)
  44                 || confess "Value " . ($_||'undef') . " did not pass container type constraint"
  45                     foreach @_;
  46             CORE::unshift @{$reader->($instance)} => @_;
  47         };
  48     }
  49     else {
  50         return sub {
  51             my $instance = CORE::shift;
  52             CORE::unshift @{$reader->($instance)} => @_;
  53         };
  54     }
  55 }
  56
  57 sub shift : method {
  58     my ($attr, $reader, $writer) = @_;
  59     return sub {
  60         CORE::shift @{$reader->($_[0])}
  61     };
  62 }
  63
  64 sub get : method {
  65     my ($attr, $reader, $writer) = @_;
  66     return sub {
  67         $reader->($_[0])->[$_[1]]
  68     };
  69 }
  70
  71 sub set : method {
  72     my ($attr, $reader, $writer) = @_;
  73     if ($attr->has_container_type) {
  74         my $container_type_constraint = $attr->container_type_constraint;
  75         return sub {
  76             ($container_type_constraint->check($_[2]))
  77                 || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
  78             $reader->($_[0])->[$_[1]] = $_[2]
  79         };
  80     }
  81     else {
  82         return sub {
  83             $reader->($_[0])->[$_[1]] = $_[2]
  84         };
  85     }
  86 }
  87
  88 1;
  89
  90 __END__
  91
  92 =pod
  93
  94 =head1 NAME
  95
  96 MooseX::AttributeHelpers::MethodProvider::Array
  97
  98 =head1 DESCRIPTION
  99
 100 This is a role which provides the method generators for
 101 L<MooseX::AttributeHelpers::Collection::Array>.
 102
 103 =head1 METHODS
 104
 105 =over 4
 106
 107 =item B<meta>
 108
 109 =back
 110
 111 =head1 PROVIDED METHODS
 112
 113 This module also consumes the B<List> method providers, to
 114 see those provied methods, refer to that documentation.
 115
 116 =over 4
 117
 118 =item B<get>
 119
 120 =item B<pop>
 121
 122 =item B<push>
 123
 124 =item B<set>
 125
 126 =item B<shift>
 127
 128 =item B<unshift>
 129
 130 =back
 131
 132 =head1 BUGS
 133
 134 All complex software has bugs lurking in it, and this module is no
 135 exception. If you find a bug please either email me, or add the bug
 136 to cpan-RT.
 137
 138 =head1 AUTHOR
 139
 140 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 141
 142 =head1 COPYRIGHT AND LICENSE
 143
 144 Copyright 2007 by Infinity Interactive, Inc.
 145
 146 L<http://www.iinteractive.com>
 147
 148 This library is free software; you can redistribute it and/or modify
 149 it under the same terms as Perl itself.
 150
 151 =cut