X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FAttributeHelpers%2FMethodProvider%2FList.pm;h=82310136f29ce5e864828b0b744a6280eb552574;hb=9807aa669ec5b7cd1cb23d3bd9fec8ad4929eb15;hp=949981a220deba0a23a79ca858033fa50983e000;hpb=99c62fb8cb5b5da1d5832062364ce48e1dd15800;p=gitmo%2FMooseX-AttributeHelpers.git diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/List.pm b/lib/MooseX/AttributeHelpers/MethodProvider/List.pm index 949981a..8231013 100644 --- a/lib/MooseX/AttributeHelpers/MethodProvider/List.pm +++ b/lib/MooseX/AttributeHelpers/MethodProvider/List.pm @@ -1,7 +1,8 @@ package MooseX::AttributeHelpers::MethodProvider::List; use Moose::Role; -our $VERSION = '0.01'; +our $VERSION = '0.21'; +$VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; sub count : method { @@ -14,7 +15,7 @@ sub count : method { sub empty : method { my ($attr, $reader, $writer) = @_; return sub { - scalar @{$reader->($_[0])} ? 1 : 0 + scalar @{$reader->($_[0])} ? 1 : 0 }; } @@ -37,6 +38,22 @@ sub map : method { }; } +sub sort : method { + my ($attr, $reader, $writer) = @_; + return sub { + my ($instance, $predicate) = @_; + die "Argument must be a code reference" + if $predicate && ref $predicate ne 'CODE'; + + if ($predicate) { + CORE::sort { $predicate->($a, $b) } @{$reader->($instance)}; + } + else { + CORE::sort @{$reader->($instance)}; + } + }; +} + sub grep : method { my ($attr, $reader, $writer) = @_; return sub { @@ -45,6 +62,43 @@ sub grep : method { }; } +sub elements : method { + my ($attr, $reader, $writer) = @_; + return sub { + my ($instance) = @_; + @{$reader->($instance)} + }; +} + +sub join : method { + my ($attr, $reader, $writer) = @_; + return sub { + my ($instance, $separator) = @_; + join $separator, @{$reader->($instance)} + }; +} + +sub get : method { + my ($attr, $reader, $writer) = @_; + return sub { + $reader->($_[0])->[$_[1]] + }; +} + +sub first : method { + my ($attr, $reader, $writer) = @_; + return sub { + $reader->($_[0])->[0] + }; +} + +sub last : method { + my ($attr, $reader, $writer) = @_; + return sub { + $reader->($_[0])->[-1] + }; +} + 1; __END__ @@ -54,7 +108,37 @@ __END__ =head1 NAME MooseX::AttributeHelpers::MethodProvider::List - + +=head1 SYNOPSIS + + package Stuff; + use Moose; + use MooseX::AttributeHelpers; + + has 'options' => ( + metaclass => 'Collection::List', + is => 'rw', + isa => 'ArrayRef[Str]', + default => sub { [] }, + auto_deref => 1, + provides => { + elements => 'all_options', + map => 'map_options', + grep => 'filter_options', + find => 'find_option', + first => 'first_option', + last => 'last_option', + get => 'get_option', + join => 'join_options', + count => 'count_options', + empty => 'do_i_have_options', + sort => 'sorted_options', + } + ); + + no Moose; + 1; + =head1 DESCRIPTION This is a role which provides the method generators for @@ -74,14 +158,98 @@ L. =item B +Returns the number of elements in the list. + + $stuff = Stuff->new; + $stuff->options(["foo", "bar", "baz", "boo"]); + + my $count = $stuff->count_options; + print "$count\n"; # prints 4 + =item B +If the list is populated, returns true. Otherwise, returns false. + + $stuff->do_i_have_options ? print "Good boy.\n" : die "No options!\n" ; + =item B +This method accepts a subroutine reference as its argument. That sub +will receive each element of the list in turn. If it returns true for +an element, that element will be returned by the C method. + + my $found = $stuff->find_option( sub { $_[0] =~ /^b/ } ); + print "$found\n"; # prints "bar" + =item B +This method accepts a subroutine reference as its argument. This +method returns every element for which that subroutine reference +returns a true value. + + my @found = $stuff->filter_options( sub { $_[0] =~ /^b/ } ); + print "@found\n"; # prints "bar baz boo" + =item B +This method accepts a subroutine reference as its argument. The +subroutine will be executed for each element of the list. It is +expected to return a modified version of that element. The return +value of the method is a list of the modified options. + + my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } ); + print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag" + +=item B + +Sorts and returns the elements of the list. + +You can provide an optional subroutine reference to sort with (as you +can with the core C function). However, instead of using C<$a> +and C<$b>, you will need to use C<$_[0]> and C<$_[1]> instead. + + # ascending ASCIIbetical + my @sorted = $stuff->sort_options(); + + # Descending alphabetical order + my @sorted_options = $stuff->sort_options( sub { lc $_[1] cmp lc $_[0] } ); + print "@sorted_options\n"; # prints "foo boo baz bar" + +=item B + +Returns all of the elements of the list + + my @option = $stuff->all_options; + print "@options\n"; # prints "foo bar baz boo" + +=item B + +Joins every element of the list using the separator given as argument. + + my $joined = $stuff->join_options( ':' ); + print "$joined\n"; # prints "foo:bar:baz:boo" + +=item B + +Returns an element of the list by its index. + + my $option = $stuff->get_option(1); + print "$option\n"; # prints "bar" + +=item B + +Returns the first element of the list. + + my $first = $stuff->first_option; + print "$first\n"; # prints "foo" + +=item B + +Returns the last element of the list. + + my $last = $stuff->last_option; + print "$last\n"; # prints "boo" + =back =head1 BUGS @@ -96,7 +264,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2007-2008 by Infinity Interactive, Inc. +Copyright 2007-2009 by Infinity Interactive, Inc. L