[gitmo/MooseX-AttributeHelpers.git] / lib / MooseX / AttributeHelpers / MethodProvider / Collection / List.pm

package MooseX::AttributeHelpers::MethodProvider::Collection::List;
use MooseX::AttributeHelpers::MethodProvider;

our $VERSION   = '0.01';
our $AUTHORITY = 'cpan:STEVAN';

add_method_provider 'Collection::List' => (
    type => 'ArrayRef',
    provides => {
        count => sub {
            my ($attr, $reader, $writer) = @_;
            return sub { scalar @{$reader->($_[0])} };
        },

        # Deprecated.  Does the opposite of its name.
        empty => sub {
            my ($attr, $reader, $writer) = @_;
            return sub { scalar @{$reader->($_[0])} ? 1 : 0 };
        },

        is_empty => sub {
            my ($attr, $reader, $writer) = @_;
            return sub { @{ $reader->($_[0]) } == 0 };
        },

        has_items => sub {
            my ($attr, $reader, $writer) = @_;
            return sub { @{ $reader->($_[0]) } > 0 };
        },

        find => sub {
            my ($attr, $reader, $writer) = @_;
            return sub {
                my ($instance, $predicate) = @_;
                foreach my $val (@{$reader->($instance)}) {
                    return $val if $predicate->($val);
                }
                return;
            };
        },

        map => sub {
            my ($attr, $reader, $writer) = @_;
            return sub {
                my ($instance, $f) = @_;
                CORE::map { $f->($_) } @{$reader->($instance)}
            };
        },

        grep => sub {
            my ($attr, $reader, $writer) = @_;
            return sub {
                my ($instance, $predicate) = @_;
                CORE::grep { $predicate->($_) } @{$reader->($instance)}
            };
        },
    },
);

1;

__END__

=pod

=head1 NAME

MooseX::AttributeHelpers::MethodProvider::List

=head1 DESCRIPTION

This is a role which provides the method generators for
L<MooseX::AttributeHelpers::Collection::List>.

=head1 PROVIDED METHODS

=over 4

=item B<count>

Returns the number of items in the list.

=item B<empty>

DEPRECATED.  This was a misleading name for what it does (returns a boolean
indicating whether the list is NOT empty), but we're keeping it for backwards
compatibility.  Do not use it in new code.  Use is_empty or has_items instead,
depending on what you meant.

=item B<is_empty>

Returns a boolean which is true if and only if the list has no items in it.

=item B<has_items>

Returns a boolean which is true if and only if the list has at least one item.

=item B<find($predicate)>

Returns the first item in the list that satisfies $predicate.

=item B<grep>

L<perlfunc/grep>

=item B<map>

L<perlfunc/map>

=back

=head1 BUGS

All complex software has bugs lurking in it, and this module is no
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2007-2008 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
Commit	Line	Data
1b45ecc4	1	package MooseX::AttributeHelpers::MethodProvider::Collection::List;
	2	use MooseX::AttributeHelpers::MethodProvider;
	3
	4	our $VERSION = '0.01';
	5	our $AUTHORITY = 'cpan:STEVAN';
	6
	7	add_method_provider 'Collection::List' => (
	8	type => 'ArrayRef',
	9	provides => {
	10	count => sub {
	11	my ($attr, $reader, $writer) = @_;
	12	return sub { scalar @{$reader->($_[0])} };
	13	},
	14
	15	# Deprecated. Does the opposite of its name.
	16	empty => sub {
	17	my ($attr, $reader, $writer) = @_;
	18	return sub { scalar @{$reader->($_[0])} ? 1 : 0 };
	19	},
	20
	21	is_empty => sub {
	22	my ($attr, $reader, $writer) = @_;
	23	return sub { @{ $reader->($_[0]) } == 0 };
	24	},
	25
	26	has_items => sub {
	27	my ($attr, $reader, $writer) = @_;
	28	return sub { @{ $reader->($_[0]) } > 0 };
	29	},
	30
	31	find => sub {
	32	my ($attr, $reader, $writer) = @_;
	33	return sub {
	34	my ($instance, $predicate) = @_;
	35	foreach my $val (@{$reader->($instance)}) {
	36	return $val if $predicate->($val);
	37	}
	38	return;
	39	};
	40	},
	41
	42	map => sub {
	43	my ($attr, $reader, $writer) = @_;
	44	return sub {
	45	my ($instance, $f) = @_;
	46	CORE::map { $f->($_) } @{$reader->($instance)}
	47	};
	48	},
	49
	50	grep => sub {
	51	my ($attr, $reader, $writer) = @_;
	52	return sub {
	53	my ($instance, $predicate) = @_;
	54	CORE::grep { $predicate->($_) } @{$reader->($instance)}
	55	};
	56	},
	57	},
	58	);
	59
	60	1;
	61
	62	__END__
	63
	64	=pod
65
66	=head1 NAME
67
68	MooseX::AttributeHelpers::MethodProvider::List
69
70	=head1 DESCRIPTION
71
72	This is a role which provides the method generators for
73	L<MooseX::AttributeHelpers::Collection::List>.
74
75	=head1 PROVIDED METHODS
76
77	=over 4
78
79	=item B<count>
80
81	Returns the number of items in the list.
82
83	=item B<empty>
84
85	DEPRECATED. This was a misleading name for what it does (returns a boolean
86	indicating whether the list is NOT empty), but we're keeping it for backwards
87	compatibility. Do not use it in new code. Use is_empty or has_items instead,
88	depending on what you meant.
89
90	=item B<is_empty>
91
92	Returns a boolean which is true if and only if the list has no items in it.
93
94	=item B<has_items>
95
96	Returns a boolean which is true if and only if the list has at least one item.
97
98	=item B<find($predicate)>
99
100	Returns the first item in the list that satisfies $predicate.
101
102	=item B<grep>
103
104	L<perlfunc/grep>
105
106	=item B<map>
107
108	L<perlfunc/map>
109
110	=back
111
112	=head1 BUGS
113
114	All complex software has bugs lurking in it, and this module is no
115	exception. If you find a bug please either email me, or add the bug
116	to cpan-RT.
117
118	=head1 AUTHOR
119
120	Stevan Little E<lt>stevan@iinteractive.comE<gt>
121
122	=head1 COPYRIGHT AND LICENSE
123
124	Copyright 2007-2008 by Infinity Interactive, Inc.
125
126	L<http://www.iinteractive.com>
127
128	This library is free software; you can redistribute it and/or modify
129	it under the same terms as Perl itself.
130
131	=cut