lib/MooseX/AttributeHelpers/MethodProvider/List.pm

   1 package MooseX::AttributeHelpers::MethodProvider::List;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.14';
   5 $VERSION = eval $VERSION;
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   8 sub count : method {
   9     my ($attr, $reader, $writer) = @_;
  10     return sub {
  11         scalar @{$reader->($_[0])}
  12     };
  13 }
  14
  15 sub empty : method {
  16     my ($attr, $reader, $writer) = @_;
  17     return sub {
  18         scalar @{$reader->($_[0])} ? 1 : 0
  19     };
  20 }
  21
  22 sub find : method {
  23     my ($attr, $reader, $writer) = @_;
  24     return sub {
  25         my ($instance, $predicate) = @_;
  26         foreach my $val (@{$reader->($instance)}) {
  27             return $val if $predicate->($val);
  28         }
  29         return;
  30     };
  31 }
  32
  33 sub map : method {
  34     my ($attr, $reader, $writer) = @_;
  35     return sub {
  36         my ($instance, $f) = @_;
  37         CORE::map { $f->($_) } @{$reader->($instance)}
  38     };
  39 }
  40
  41 sub grep : method {
  42     my ($attr, $reader, $writer) = @_;
  43     return sub {
  44         my ($instance, $predicate) = @_;
  45         CORE::grep { $predicate->($_) } @{$reader->($instance)}
  46     };
  47 }
  48
  49 sub elements : method {
  50     my ($attr, $reader, $writer) = @_;
  51     return sub {
  52         my ($instance) = @_;
  53         @{$reader->($instance)}
  54     };
  55 }
  56
  57 sub join : method {
  58     my ($attr, $reader, $writer) = @_;
  59     return sub {
  60         my ($instance, $separator) = @_;
  61         join $separator, @{$reader->($instance)}
  62     };
  63 }
  64
  65 sub get : method {
  66     my ($attr, $reader, $writer) = @_;
  67     return sub {
  68         $reader->($_[0])->[$_[1]]
  69     };
  70 }
  71
  72 sub first : method {
  73     my ($attr, $reader, $writer) = @_;
  74     return sub {
  75         $reader->($_[0])->[0]
  76     };
  77 }
  78
  79 sub last : method {
  80     my ($attr, $reader, $writer) = @_;
  81     return sub {
  82         $reader->($_[0])->[-1]
  83     };
  84 }
  85
  86 1;
  87
  88 __END__
  89
  90 =pod
  91
  92 =head1 NAME
  93
  94 MooseX::AttributeHelpers::MethodProvider::List
  95
  96 =SYNOPSIS
  97
  98    package Stuff;
  99    use Moose;
 100    use MooseX::AttributeHelpers;
 101
 102    has 'options' => (
 103       metaclass  => 'Collection::List',
 104       is         => 'rw',
 105       isa        => 'ArrayRef[Str]',
 106       default    => sub { [] },
 107       auto_deref => 1,
 108       provides   => {
 109          map   => 'map_options',
 110          grep  => 'filter_options',
 111          find  => 'find_option',
 112          first => 'first_option',
 113          last  => 'last_option',
 114          get   => 'get_option',
 115          join  => 'join_options',
 116          count => 'count_options',
 117          empty => 'do_i_have_options',
 118
 119       }
 120    );
 121
 122    no Moose;
 123    1;
 124
 125 =head1 DESCRIPTION
 126
 127 This is a role which provides the method generators for
 128 L<MooseX::AttributeHelpers::Collection::List>.
 129
 130 =head1 METHODS
 131
 132 =over 4
 133
 134 =item B<meta>
 135
 136 =back
 137
 138 =head1 PROVIDED METHODS
 139
 140 =over 4
 141
 142 =item B<count>
 143 Returns the number of elements of the list.
 144
 145    $stuff = Stuff->new;
 146    $stuff->options(["foo", "bar", "baz", "boo"]);
 147
 148    my $count = $stuff->count_options;
 149    print "$count\n"; # prints 4
 150
 151 =item B<empty>
 152 If the list is populated, returns true. Otherwise, returns false.
 153
 154    $stuff->do_i_have_options ? print "Good boy.\n" : die "No options!\n" ;
 155
 156 =item B<find>
 157 Returns the first element that returns true in the anonymous subroutine
 158 passed as argument.
 159
 160    my $found = $stuff->find_option( sub { $_[0] =~ /^b/ } );
 161    print "$found\n"; # prints "bar"
 162
 163 =item B<grep>
 164 Returns every elemnt of the list that returns true in the anonymous
 165 subroutine passed as argument.
 166
 167    my @found = $stuff->filter_options( sub { $_[0] =~ /^b/ } );
 168    print "@found\n"; # prints "bar baz boo"
 169
 170 =item B<map>
 171 Executes the anonymouse subroutine given as argument sequentially
 172 for each element of the list.
 173
 174 my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } );
 175 print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag"
 176
 177 =item B<elements>
 178 Returns an element of the list by its index.
 179
 180    my $option = $stuff->get_option(1);
 181    print "$option\n"; # prints "bar"
 182
 183 =item B<join>
 184 Joins every elemnt of the list using the separator given as argument.
 185
 186    my $joined = $stuff->join_options( ':' );
 187    print "$joined\n"; # prints "foo:bar:baz:boo"
 188
 189 =item B<get>
 190 Returns an element of the list by its index.
 191
 192    my $option = $stuff->get_option(1);
 193    print "$option\n"; # prints "bar"
 194
 195 =item B<first>
 196 Returns the first element.
 197
 198    my $first = $stuff->first_option;
 199    print "$first\n"; # prints "foo"
 200
 201 =item B<last>
 202 Returns the last item.
 203
 204    my $last = $stuff->last_option;
 205    print "$last\n"; # prints "boo"
 206
 207 =back
 208
 209 =head1 BUGS
 210
 211 All complex software has bugs lurking in it, and this module is no
 212 exception. If you find a bug please either email me, or add the bug
 213 to cpan-RT.
 214
 215 =head1 AUTHOR
 216
 217 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 218
 219 =head1 COPYRIGHT AND LICENSE
 220
 221 Copyright 2007-2008 by Infinity Interactive, Inc.
 222
 223 L<http://www.iinteractive.com>
 224
 225 This library is free software; you can redistribute it and/or modify
 226 it under the same terms as Perl itself.
 227
 228 =cut