lib/MooseX/AttributeHelpers/MethodProvider/List.pm

   1 package MooseX::AttributeHelpers::MethodProvider::List;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.20';
   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 sort : method {
  42     my ($attr, $reader, $writer) = @_;
  43     return sub {
  44         my ($instance, $predicate) = @_;
  45         die "Argument must be a code reference"
  46             if $predicate && ref $predicate ne 'CODE';
  47
  48         if ($predicate) {
  49             CORE::sort { $predicate->($a, $b) } @{$reader->($instance)};
  50         }
  51         else {
  52             CORE::sort @{$reader->($instance)};
  53         }
  54     };
  55 }
  56
  57 sub grep : method {
  58     my ($attr, $reader, $writer) = @_;
  59     return sub {
  60         my ($instance, $predicate) = @_;
  61         CORE::grep { $predicate->($_) } @{$reader->($instance)}
  62     };
  63 }
  64
  65 sub elements : method {
  66     my ($attr, $reader, $writer) = @_;
  67     return sub {
  68         my ($instance) = @_;
  69         @{$reader->($instance)}
  70     };
  71 }
  72
  73 sub join : method {
  74     my ($attr, $reader, $writer) = @_;
  75     return sub {
  76         my ($instance, $separator) = @_;
  77         join $separator, @{$reader->($instance)}
  78     };
  79 }
  80
  81 sub get : method {
  82     my ($attr, $reader, $writer) = @_;
  83     return sub {
  84         $reader->($_[0])->[$_[1]]
  85     };
  86 }
  87
  88 sub first : method {
  89     my ($attr, $reader, $writer) = @_;
  90     return sub {
  91         $reader->($_[0])->[0]
  92     };
  93 }
  94
  95 sub last : method {
  96     my ($attr, $reader, $writer) = @_;
  97     return sub {
  98         $reader->($_[0])->[-1]
  99     };
 100 }
 101
 102 1;
 103
 104 __END__
 105
 106 =pod
 107
 108 =head1 NAME
 109
 110 MooseX::AttributeHelpers::MethodProvider::List
 111
 112 =head1 SYNOPSIS
 113
 114    package Stuff;
 115    use Moose;
 116    use MooseX::AttributeHelpers;
 117
 118    has 'options' => (
 119        metaclass  => 'Collection::List',
 120        is         => 'rw',
 121        isa        => 'ArrayRef[Str]',
 122        default    => sub { [] },
 123        auto_deref => 1,
 124        provides   => {
 125            elements => 'all_options',
 126            map      => 'map_options',
 127            grep     => 'filter_options',
 128            find     => 'find_option',
 129            first    => 'first_option',
 130            last     => 'last_option',
 131            get      => 'get_option',
 132            join     => 'join_options',
 133            count    => 'count_options',
 134            empty    => 'do_i_have_options',
 135            sort     => 'sorted_options',
 136        }
 137    );
 138
 139    no Moose;
 140    1;
 141
 142 =head1 DESCRIPTION
 143
 144 This is a role which provides the method generators for
 145 L<MooseX::AttributeHelpers::Collection::List>.
 146
 147 =head1 METHODS
 148
 149 =over 4
 150
 151 =item B<meta>
 152
 153 =back
 154
 155 =head1 PROVIDED METHODS
 156
 157 =over 4
 158
 159 =item B<count>
 160
 161 Returns the number of elements in the list.
 162
 163    $stuff = Stuff->new;
 164    $stuff->options(["foo", "bar", "baz", "boo"]);
 165
 166    my $count = $stuff->count_options;
 167    print "$count\n"; # prints 4
 168
 169 =item B<empty>
 170
 171 If the list is populated, returns true. Otherwise, returns false.
 172
 173    $stuff->do_i_have_options ? print "Good boy.\n" : die "No options!\n" ;
 174
 175 =item B<find>
 176
 177 This method accepts a subroutine reference as its argument. That sub
 178 will receive each element of the list in turn. If it returns true for
 179 an element, that element will be returned by the C<find> method.
 180
 181    my $found = $stuff->find_option( sub { $_[0] =~ /^b/ } );
 182    print "$found\n"; # prints "bar"
 183
 184 =item B<grep>
 185
 186 This method accepts a subroutine reference as its argument. This
 187 method returns every element for which that subroutine reference
 188 returns a true value.
 189
 190    my @found = $stuff->filter_options( sub { $_[0] =~ /^b/ } );
 191    print "@found\n"; # prints "bar baz boo"
 192
 193 =item B<map>
 194
 195 This method accepts a subroutine reference as its argument. The
 196 subroutine will be executed for each element of the list. It is
 197 expected to return a modified version of that element. The return
 198 value of the method is a list of the modified options.
 199
 200    my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } );
 201    print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag"
 202
 203 =item B<sort>
 204
 205 Sorts and returns the elements of the list.
 206
 207 You can provide an optional subroutine reference to sort with (as you
 208 can with the core C<sort> function). However, instead of using C<$a>
 209 and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead.
 210
 211    # ascending ASCIIbetical
 212    my @sorted = $stuff->sort_options();
 213
 214    # Descending alphabetical order
 215    my @sorted_options = $stuff->sort_options( sub { lc $_[1] cmp lc $_[0] } );
 216    print "@sorted_options\n"; # prints "foo boo baz bar"
 217
 218 =item B<elements>
 219
 220 Returns all of the elements of the list
 221
 222    my @option = $stuff->all_options;
 223    print "@options\n"; # prints "foo bar baz boo"
 224
 225 =item B<join>
 226
 227 Joins every element of the list using the separator given as argument.
 228
 229    my $joined = $stuff->join_options( ':' );
 230    print "$joined\n"; # prints "foo:bar:baz:boo"
 231
 232 =item B<get>
 233
 234 Returns an element of the list by its index.
 235
 236    my $option = $stuff->get_option(1);
 237    print "$option\n"; # prints "bar"
 238
 239 =item B<first>
 240
 241 Returns the first element of the list.
 242
 243    my $first = $stuff->first_option;
 244    print "$first\n"; # prints "foo"
 245
 246 =item B<last>
 247
 248 Returns the last element of the list.
 249
 250    my $last = $stuff->last_option;
 251    print "$last\n"; # prints "boo"
 252
 253 =back
 254
 255 =head1 BUGS
 256
 257 All complex software has bugs lurking in it, and this module is no
 258 exception. If you find a bug please either email me, or add the bug
 259 to cpan-RT.
 260
 261 =head1 AUTHOR
 262
 263 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 264
 265 =head1 COPYRIGHT AND LICENSE
 266
 267 Copyright 2007-2009 by Infinity Interactive, Inc.
 268
 269 L<http://www.iinteractive.com>
 270
 271 This library is free software; you can redistribute it and/or modify
 272 it under the same terms as Perl itself.
 273
 274 =cut