[Moose-commits] r7339 - in MooseX-AttributeHelpers/trunk:
lib/MooseX/AttributeHelpers/MethodProvider t
brunov at code2.0beta.co.uk
brunov at code2.0beta.co.uk
Sun Jan 18 12:58:14 GMT 2009
Author: brunov
Date: 2009-01-18 04:58:14 -0800 (Sun, 18 Jan 2009)
New Revision: 7339
Modified:
MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm
MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm
MooseX-AttributeHelpers/trunk/t/002_basic_array.t
MooseX-AttributeHelpers/trunk/t/005_basic_list.t
Log:
Implemented List::sort and Array::sort_in_place. Added basic tests and pod.
Modified: MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm
===================================================================
--- MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm 2009-01-18 09:42:11 UTC (rev 7338)
+++ MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/Array.pm 2009-01-18 12:58:14 UTC (rev 7339)
@@ -136,6 +136,18 @@
}
}
+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 @@
=item B<splice>
+=item B<sort_in_place>
+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
Modified: MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm
===================================================================
--- MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm 2009-01-18 09:42:11 UTC (rev 7338)
+++ MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm 2009-01-18 12:58:14 UTC (rev 7339)
@@ -38,6 +38,16 @@
};
}
+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 @@
MooseX::AttributeHelpers::MethodProvider::List
-=SYNOPSIS
+=head1 SYNOPSIS
package Stuff;
use Moose;
@@ -115,6 +125,7 @@
join => 'join_options',
count => 'count_options',
empty => 'do_i_have_options',
+ sort => 'sort_options',
}
);
@@ -171,9 +182,20 @@
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<sort>
+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<elements>
Returns an element of the list by its index.
Modified: MooseX-AttributeHelpers/trunk/t/002_basic_array.t
===================================================================
--- MooseX-AttributeHelpers/trunk/t/002_basic_array.t 2009-01-18 09:42:11 UTC (rev 7338)
+++ MooseX-AttributeHelpers/trunk/t/002_basic_array.t 2009-01-18 12:58:14 UTC (rev 7339)
@@ -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 @@
'count' => 'num_options',
'empty' => 'has_options',
'clear' => 'clear_options',
+ 'sort_in_place' => 'sort_in_place_options',
},
curries => {
'push' => {
@@ -36,7 +37,9 @@
},
'unshift' => {
prepend_prerequisites_along_with => ['first', 'second']
- }
+ },
+ 'sort_in_place' => { ascending_options => [ sub { $_[0] <=> $_[1] } ],
+ },
}
);
}
@@ -54,6 +57,7 @@
num_options
clear_options
has_options
+ sort_in_place_options
];
is_deeply($stuff->options, [10, 12], '... got options');
@@ -120,6 +124,18 @@
$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 @@
$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 @@
'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');
Modified: MooseX-AttributeHelpers/trunk/t/005_basic_list.t
===================================================================
--- MooseX-AttributeHelpers/trunk/t/005_basic_list.t 2009-01-18 09:42:11 UTC (rev 7338)
+++ MooseX-AttributeHelpers/trunk/t/005_basic_list.t 2009-01-18 12:58:14 UTC (rev 7339)
@@ -7,7 +7,7 @@
use Test::Exception;
BEGIN {
- plan tests => 29;
+ plan tests => 33;
}
BEGIN {
@@ -35,11 +35,13 @@
'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 @@
options
join_options
get_option_at
+ sort_options
];
is_deeply($stuff->_options, [1 .. 10], '... got options');
@@ -80,7 +83,7 @@
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($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 @@
'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 @@
'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';
+
More information about the Moose-commits
mailing list