lib/MooseX/AttributeHelpers/Collection/Array.pm

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