2 package MooseX::AttributeHelpers::Collection::Array;
4 use Moose::Util::TypeConstraints;
7 our $AUTHORITY = 'cpan:STEVAN';
9 extends 'Moose::Meta::Attribute';
11 my %METHOD_CONSTRUCTORS = (
16 push @{$attr->get_value($instance)} => @_;
21 return sub { pop @{$attr->get_value($_[0])} };
27 unshift @{$attr->get_value($instance)} => @_;
32 return sub { shift @{$attr->get_value($_[0])} };
36 return sub { $attr->get_value($_[0])->[$_[1]] };
40 return sub { $attr->get_value($_[0])->[$_[1]] = $_[2] };
46 isa => subtype('HashRef' => where {
47 (exists $METHOD_CONSTRUCTORS{$_} || return) for keys %{$_}; 1;
52 has '+$!default' => (required => 1);
53 has '+type_constraint' => (required => 1);
55 before '_process_options' => sub {
56 my ($self, %options) = @_;
58 if (exists $options{provides}) {
59 (exists $options{isa})
60 || confess "You must define a type with the Array metaclass";
62 (find_type_constraint($options{isa})->is_subtype_of('ArrayRef'))
63 || confess "The type constraint for a Array must be a subtype of ArrayRef";
67 after 'install_accessors' => sub {
69 my $class = $attr->associated_class;
71 foreach my $key (keys %{$attr->provides}) {
72 (exists $METHOD_CONSTRUCTORS{$key})
73 || confess "Unsupported method type ($key)";
75 $attr->provides->{$key},
76 $METHOD_CONSTRUCTORS{$key}->($attr)
82 no Moose::Util::TypeConstraints;
84 # register the alias ...
85 package Moose::Meta::Attribute::Custom::Collection;
86 sub register_implementation { 'MooseX::AttributeHelpers::Collection::Array' }
103 metaclass => 'Collection',
106 default => sub { [] },
108 'push' => 'add_options',
109 'pop' => 'remove_last_option',
119 All complex software has bugs lurking in it, and this module is no
120 exception. If you find a bug please either email me, or add the bug
125 Stevan Little E<lt>stevan@iinteractive.comE<gt>
127 =head1 COPYRIGHT AND LICENSE
129 Copyright 2007 by Infinity Interactive, Inc.
131 L<http://www.iinteractive.com>
133 This library is free software; you can redistribute it and/or modify
134 it under the same terms as Perl itself.