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