From: Bruno Vecchi Date: Sun, 18 Jan 2009 12:58:14 +0000 (+0000) Subject: Implemented List::sort and Array::sort_in_place. Added basic tests and pod. X-Git-Tag: 0.16~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=80894c0a1ffbfc88044d53124bdd663cbd781faa;p=gitmo%2FMooseX-AttributeHelpers.git Implemented List::sort and Array::sort_in_place. Added basic tests and pod. --- diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm index 6d314ff..fb228f6 100644 --- a/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm +++ b/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm @@ -136,6 +136,18 @@ sub splice : method { } } +sub sort_in_place : method { + my ($attr, $reader, $writer) = @_; + return sub { + my ($instance, $predicate) = @_; + die "Argument must be a code reference" + unless ref $predicate eq "CODE"; + my @sorted = + CORE::sort { $predicate->($a, $b) } @{$reader->($instance)}; + $writer->($instance, \@sorted); + } +} + 1; __END__ @@ -186,6 +198,11 @@ see those provied methods, refer to that documentation. =item B +=item B +Sorts the array using the comparison subroutine given as argument. +Instead of returning the sorted list, it modifies the order of the +items in the ArrayRef attribute. + =back =head1 BUGS diff --git a/lib/MooseX/AttributeHelpers/MethodProvider/List.pm b/lib/MooseX/AttributeHelpers/MethodProvider/List.pm index 95648cc..5fa24fe 100644 --- a/lib/MooseX/AttributeHelpers/MethodProvider/List.pm +++ b/lib/MooseX/AttributeHelpers/MethodProvider/List.pm @@ -38,6 +38,16 @@ sub map : method { }; } +sub sort : method { + my ($attr, $reader, $writer) = @_; + return sub { + my ($instance, $predicate) = @_; + die "Argument must be a code reference" + unless ref $predicate eq "CODE"; + CORE::sort { $predicate->($a, $b) } @{$reader->($instance)}; + }; +} + sub grep : method { my ($attr, $reader, $writer) = @_; return sub { @@ -93,7 +103,7 @@ __END__ MooseX::AttributeHelpers::MethodProvider::List -=SYNOPSIS +=head1 SYNOPSIS package Stuff; use Moose; @@ -115,6 +125,7 @@ MooseX::AttributeHelpers::MethodProvider::List join => 'join_options', count => 'count_options', empty => 'do_i_have_options', + sort => 'sort_options', } ); @@ -171,8 +182,19 @@ subroutine passed as argument. Executes the anonymous subroutine given as argument sequentially for each element of the list. -my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } ); -print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag" + my @mod_options = $stuff->map_options( sub { $_[0] . "-tag" } ); + print "@mod_options\n"; # prints "foo-tag bar-tag baz-tag boo-tag" + +=item B +Returns a sorted list of the elements, using the anonymous subroutine +given as argument. + +This subroutine should perform a comparison between the two arguments passed +to it, and return a numeric list with the results of such comparison: + + # Descending alphabetical order + my @sorted_options = $stuff->sort_options( sub { $_[1] cmp $_[0] } ); + print "@sorted_options\n"; # prints "foo boo baz bar" =item B Returns an element of the list by its index. diff --git a/t/002_basic_array.t b/t/002_basic_array.t index 1153247..ad988e2 100644 --- a/t/002_basic_array.t +++ b/t/002_basic_array.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 55; +use Test::More tests => 60; use Test::Exception; BEGIN { @@ -29,6 +29,7 @@ BEGIN { 'count' => 'num_options', 'empty' => 'has_options', 'clear' => 'clear_options', + 'sort_in_place' => 'sort_in_place_options', }, curries => { 'push' => { @@ -36,7 +37,9 @@ BEGIN { }, 'unshift' => { prepend_prerequisites_along_with => ['first', 'second'] - } + }, + 'sort_in_place' => { ascending_options => [ sub { $_[0] <=> $_[1] } ], + }, } ); } @@ -54,6 +57,7 @@ can_ok($stuff, $_) for qw[ num_options clear_options has_options + sort_in_place_options ]; is_deeply($stuff->options, [10, 12], '... got options'); @@ -120,6 +124,18 @@ is($stuff->get_option_at(0), 20, '... get option at index 0'); $stuff->clear_options; is_deeply( $stuff->options, [], "... clear options" ); +$stuff->add_options(1..3); +$stuff->sort_in_place_options( sub { $_[1] <=> $_[0] } ); +is_deeply( $stuff->options, [3, 2, 1], "... sort options in place" ); + +lives_ok { + $stuff->ascending_options(); +} '... add descending options okay'; + +is_deeply( $stuff->options, [1, 2, 3], "... sort currying" ); + +$stuff->clear_options; + lives_ok { $stuff->add_options('tree'); } '... set the options okay'; @@ -163,6 +179,11 @@ dies_ok { $stuff->set_option_at( 0, undef ); } '... rejects set of an invalid type'; +dies_ok { + my $stuff = Stuff->new(); + $stuff->sort_in_place_options( undef ); +} '... sort rejects arg of invalid type'; + ## test the meta my $options = $stuff->meta->get_attribute('options'); @@ -178,6 +199,7 @@ is_deeply($options->provides, { 'count' => 'num_options', 'empty' => 'has_options', 'clear' => 'clear_options', + 'sort_in_place' => 'sort_in_place_options', }, '... got the right provies mapping'); is($options->type_constraint->type_parameter, 'Str', '... got the right container type'); diff --git a/t/005_basic_list.t b/t/005_basic_list.t index d4a49b7..e295fdf 100644 --- a/t/005_basic_list.t +++ b/t/005_basic_list.t @@ -7,7 +7,7 @@ use Test::More; use Test::Exception; BEGIN { - plan tests => 29; + plan tests => 33; } BEGIN { @@ -35,11 +35,13 @@ BEGIN { 'get' => 'get_option_at', 'first' => 'get_first_option', 'last' => 'get_last_option', + 'sort' => 'sort_options', }, curries => { 'grep' => {less_than_five => [ sub { $_ < 5 } ]}, 'map' => {up_by_one => [ sub { $_ + 1 } ]}, - 'join' => {dashify => [ '-' ]} + 'join' => {dashify => [ '-' ]}, + 'sort' => {ascending => [ sub { $_[0] <=> $_[1] } ]}, } ); @@ -72,6 +74,7 @@ can_ok($stuff, $_) for qw[ options join_options get_option_at + sort_options ]; is_deeply($stuff->_options, [1 .. 10], '... got options'); @@ -80,7 +83,7 @@ ok($stuff->has_options, '... we have options'); is($stuff->num_options, 10, '... got 2 options'); cmp_ok($stuff->get_option_at(0), '==', 1, '... get option 0'); cmp_ok($stuff->get_first_option, '==', 1, '... get first'); -cmp_ok($stuff->get_last_option, '==', 10, '... get first'); +cmp_ok($stuff->get_last_option, '==', 10, '... get last'); is_deeply( [ $stuff->filter_options(sub { $_[0] % 2 == 0 }) ], @@ -100,6 +103,8 @@ is_deeply([ $stuff->options ], [1 .. 10], '... got the list of options'); is($stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10', '... joined the list of options by :'); +is_deeply([ $stuff->sort_options( sub { $_[1] <=> $_[0] } ) ], [sort { $b <=> $a } (1..10)], '... got sorted options'); + # test the currying is_deeply([ $stuff->less_than_five() ], [1 .. 4]); @@ -116,6 +121,8 @@ is_deeply( 'returns all elements with double length of string "fish"' ); +is_deeply([$stuff->ascending], [1 .. 10]); + ## test the meta my $options = $stuff->meta->get_attribute('_options'); @@ -131,7 +138,13 @@ is_deeply($options->provides, { 'join' => 'join_options', 'get' => 'get_option_at', 'first' => 'get_first_option', - 'last' => 'get_last_option' + 'last' => 'get_last_option', + 'sort' => 'sort_options', }, '... got the right provies mapping'); is($options->type_constraint->type_parameter, 'Int', '... got the right container type'); + +dies_ok { + $stuff->sort_in_place_options( undef ); +} '... sort rejects arg of invalid type'; +