lib/MooseX/AttributeHelpers/MethodProvider/Array.pm

   1 package MooseX::AttributeHelpers::MethodProvider::Array;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.02';
   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 clear : method {
  65     my ($attr, $reader, $writer) = @_;
  66     return sub {
  67         @{$reader->($_[0])} = ()
  68     };
  69 }
  70
  71 sub get : method {
  72     my ($attr, $reader, $writer) = @_;
  73     return sub {
  74         $reader->($_[0])->[$_[1]]
  75     };
  76 }
  77
  78 sub set : method {
  79     my ($attr, $reader, $writer) = @_;
  80     if ($attr->has_container_type) {
  81         my $container_type_constraint = $attr->container_type_constraint;
  82         return sub {
  83             ($container_type_constraint->check($_[2]))
  84                 || confess "Value " . ($_[2]||'undef') . " did not pass container type constraint";
  85             $reader->($_[0])->[$_[1]] = $_[2]
  86         };
  87     }
  88     else {
  89         return sub {
  90             $reader->($_[0])->[$_[1]] = $_[2]
  91         };
  92     }
  93 }
  94
  95 1;
  96
  97 __END__
  98
  99 =pod
 100
 101 =head1 NAME
 102
 103 MooseX::AttributeHelpers::MethodProvider::Array
 104
 105 =head1 DESCRIPTION
 106
 107 This is a role which provides the method generators for
 108 L<MooseX::AttributeHelpers::Collection::Array>.
 109
 110 =head1 METHODS
 111
 112 =over 4
 113
 114 =item B<meta>
 115
 116 =back
 117
 118 =head1 PROVIDED METHODS
 119
 120 This module also consumes the B<List> method providers, to
 121 see those provied methods, refer to that documentation.
 122
 123 =over 4
 124
 125 =item B<get>
 126
 127 =item B<pop>
 128
 129 =item B<push>
 130
 131 =item B<set>
 132
 133 =item B<shift>
 134
 135 =item B<unshift>
 136
 137 =item B<clear>
 138
 139 =back
 140
 141 =head1 BUGS
 142
 143 All complex software has bugs lurking in it, and this module is no
 144 exception. If you find a bug please either email me, or add the bug
 145 to cpan-RT.
 146
 147 =head1 AUTHOR
 148
 149 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 150
 151 =head1 COPYRIGHT AND LICENSE
 152
 153 Copyright 2007 by Infinity Interactive, Inc.
 154
 155 L<http://www.iinteractive.com>
 156
 157 This library is free software; you can redistribute it and/or modify
 158 it under the same terms as Perl itself.
 159
 160 =cut