Add a "join" provided method to lists (I do have a use case, shaddap!)
[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider / List.pm
CommitLineData
457dc4fb 1package MooseX::AttributeHelpers::MethodProvider::List;
2use Moose::Role;
3
c91a1347 4our $VERSION = '0.01';
457dc4fb 5our $AUTHORITY = 'cpan:STEVAN';
6
7sub count : method {
8 my ($attr, $reader, $writer) = @_;
9 return sub {
10 scalar @{$reader->($_[0])}
11 };
12}
13
14sub empty : method {
15 my ($attr, $reader, $writer) = @_;
16 return sub {
facf2175 17 scalar @{$reader->($_[0])} ? 1 : 0
457dc4fb 18 };
19}
20
21sub find : method {
22 my ($attr, $reader, $writer) = @_;
23 return sub {
24 my ($instance, $predicate) = @_;
25 foreach my $val (@{$reader->($instance)}) {
26 return $val if $predicate->($val);
27 }
28 return;
29 };
30}
31
32sub map : method {
33 my ($attr, $reader, $writer) = @_;
34 return sub {
35 my ($instance, $f) = @_;
36 CORE::map { $f->($_) } @{$reader->($instance)}
37 };
38}
39
40sub grep : method {
41 my ($attr, $reader, $writer) = @_;
42 return sub {
43 my ($instance, $predicate) = @_;
44 CORE::grep { $predicate->($_) } @{$reader->($instance)}
45 };
46}
47
6f60a71e 48sub elements : method {
49 my ($attr, $reader, $writer) = @_;
50 return sub {
c80e1668 51 my ($instance) = @_;
6f60a71e 52 @{$reader->($instance)}
53 };
54}
55
654096bc 56sub join : method {
57 my ($attr, $reader, $writer) = @_;
58 return sub {
59 my ($instance, $separator) = @_;
60 join $separator, @{$reader->($instance)}
61 };
62}
63
457dc4fb 641;
65
66__END__
67
68=pod
69
70=head1 NAME
71
72MooseX::AttributeHelpers::MethodProvider::List
73
74=head1 DESCRIPTION
75
76This is a role which provides the method generators for
77L<MooseX::AttributeHelpers::Collection::List>.
78
79=head1 METHODS
80
81=over 4
82
83=item B<meta>
84
85=back
86
87=head1 PROVIDED METHODS
88
89=over 4
90
91=item B<count>
92
93=item B<empty>
94
95=item B<find>
96
97=item B<grep>
98
99=item B<map>
100
6f60a71e 101=item B<elements>
102
654096bc 103=item B<join>
104
457dc4fb 105=back
106
107=head1 BUGS
108
109All complex software has bugs lurking in it, and this module is no
110exception. If you find a bug please either email me, or add the bug
111to cpan-RT.
112
113=head1 AUTHOR
114
115Stevan Little E<lt>stevan@iinteractive.comE<gt>
116
117=head1 COPYRIGHT AND LICENSE
118
99c62fb8 119Copyright 2007-2008 by Infinity Interactive, Inc.
457dc4fb 120
121L<http://www.iinteractive.com>
122
123This library is free software; you can redistribute it and/or modify
124it under the same terms as Perl itself.
125
126=cut