[Moose-commits] r7341 - in MooseX-AttributeHelpers/trunk: lib/MooseX/AttributeHelpers/MethodProvider t

[autarch at code2.0beta.co.uk]

Author: autarch
Date: 2009-01-18 13:17:09 -0800 (Sun, 18 Jan 2009)
New Revision: 7341

Modified:
   MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm
   MooseX-AttributeHelpers/trunk/t/005_basic_list.t
Log:
Allow the sort provider to _not_ receive a coderef, and just use
Perl's native sort order in that case. Also tweak the tests and docs
for this feature.

Modified: MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm
===================================================================
--- MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm	2009-01-18 15:22:57 UTC (rev 7340)
+++ MooseX-AttributeHelpers/trunk/lib/MooseX/AttributeHelpers/MethodProvider/List.pm	2009-01-18 21:17:09 UTC (rev 7341)
@@ -42,9 +42,15 @@
     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)};
+        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)};
+        }
     };
 }
 
@@ -125,7 +131,7 @@
          join  => 'join_options',
          count => 'count_options',
          empty => 'do_i_have_options',
-         sort  => 'sort_options',
+         sort  => 'sorted_options',
 
       }
    );
@@ -186,14 +192,17 @@
    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:
+Returns a sorted list of the elements. You can optionally provide a
+subroutine reference to sort with (as you can with the core C<sort>
+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 { $_[1] cmp $_[0] } );
+   my @sorted_options = $stuff->sort_options( sub { lc $_[1] cmp lc $_[0] } );
    print "@sorted_options\n"; # prints "foo boo baz bar"
 
 =item B<elements>

Modified: MooseX-AttributeHelpers/trunk/t/005_basic_list.t
===================================================================
--- MooseX-AttributeHelpers/trunk/t/005_basic_list.t	2009-01-18 15:22:57 UTC (rev 7340)
+++ MooseX-AttributeHelpers/trunk/t/005_basic_list.t	2009-01-18 21:17:09 UTC (rev 7341)
@@ -3,14 +3,10 @@
 use strict;
 use warnings;
 
-use Test::More;
+use Test::More tests => 35;
 use Test::Exception;
 
 BEGIN {
-   plan tests => 33;
-}
-
-BEGIN {
     use_ok('MooseX::AttributeHelpers');   
 }
 
@@ -35,13 +31,13 @@
             'get'      => 'get_option_at',
             'first'    => 'get_first_option',
             'last'     => 'get_last_option',
-            'sort' => 'sort_options',
+            'sort'     => 'sorted_options',
         },
         curries   => {
             'grep'     => {less_than_five => [ sub { $_ < 5 } ]},
             'map'      => {up_by_one      => [ sub { $_ + 1 } ]},
             'join'     => {dashify        => [ '-' ]},
-            'sort'     => {ascending      => [ sub { $_[0] <=> $_[1] } ]},
+            'sort'     => {descending     => [ sub { $_[1] <=> $_[0] } ]},
         }
     );
 
@@ -74,7 +70,7 @@
     options
     join_options
     get_option_at
-    sort_options
+    sorted_options
 ];
 
 is_deeply($stuff->_options, [1 .. 10], '... got options');
@@ -103,8 +99,14 @@
 
 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');
+is_deeply([ $stuff->sorted_options ], [sort (1..10)],
+          '... got sorted options (default sort order)');
+is_deeply([ $stuff->sorted_options( sub { $_[1] <=> $_[0] } ) ], [sort { $b <=> $a } (1..10)],
+          '... got sorted options (descending sort order) ');
 
+throws_ok { $stuff->sorted_options('foo') } qr/Argument must be a code reference/,
+    'error when sort receives a non-coderef argument';
+
 # test the currying
 is_deeply([ $stuff->less_than_five() ], [1 .. 4]);
 
@@ -121,7 +123,7 @@
         'returns all elements with double length of string "fish"'
 );
 
-is_deeply([$stuff->ascending], [1 .. 10]);
+is_deeply([$stuff->descending], [reverse 1 .. 10]);
 
 ## test the meta
 
@@ -139,8 +141,8 @@
     'get'      => 'get_option_at',
     'first'    => 'get_first_option',
     'last'     => 'get_last_option',
-    'sort' => 'sort_options',
-}, '... got the right provies mapping');
+    'sort'     => 'sorted_options',
+}, '... got the right provides mapping');
 
 is($options->type_constraint->type_parameter, 'Int', '... got the right container type');