refactor curries usage
Jason May [Sat, 21 Jun 2008 05:30:49 +0000 (05:30 +0000)]
lib/MooseX/AttributeHelpers.pm
lib/MooseX/AttributeHelpers/Base.pm
t/002_basic_array.t
t/003_basic_hash.t
t/004_basic_number.t
t/005_basic_list.t
t/007_basic_string.t

index 691e9ae..7815223 100644 (file)
@@ -45,7 +45,7 @@ MooseX::AttributeHelpers - Extend your attribute interfaces
           set       => 'set_mapping',
       },
       curries  => {
-          set       => [ set_quantity => 'quantity' ]
+          set       => { set_quantity => [ 'quantity' ] }
       }
   );
 
@@ -77,13 +77,13 @@ C<metaclass> parameter. Available meta classes are:
 =head2 provides
 
 This points to a hashref that uses C<provider> for the keys and
-C<['method', @args]> for the values.  The method will be added to
+C<method> for the values.  The method will be added to
 the object itself and do what you want.
 
 =head2 curries
 
 This points to a hashref that uses C<provider> for the keys and
-C<['method', @args]> for the values.  The method will be added to
+C<< {method => [ @args ]} >> for the values.  The method will be added to
 the object itself (always using C<@args> as the beginning arguments).
 
 =head1 METHOD PROVIDERS
index bc72738..8fd2d97 100644 (file)
@@ -104,7 +104,6 @@ sub _curry {
     my $self = shift;
     my $code = shift;
 
-    #warn "_curry: "; use DDS; warn Dump($self);
     my @args = @_;
     return sub { my $self = shift; $code->($self, @args, @_) };
 }
@@ -129,28 +128,47 @@ after 'install_accessors' => sub {
 
     my $class_name = $class->name;
 
-    foreach my $key (keys %{$attr->curries}) {
-
-        my ($curried_name, @curried_args) = @{ $attr->curries->{$key} };
-
-        if ($class->has_method($curried_name)) {
-            confess "The method ($curried_name) already exists in class (" . $class->name . ")";
+    while (my ($constructor, $constructed) = each %{$attr->curries}) {
+        my $method_code;
+        if (ref $constructed eq 'HASH') {
+            while (my ($curried_name, $curried_args) = each(%$constructed)) {
+#                warn "CURRIED_NAME: $curried_name";
+                if ($class->has_method($curried_name)) {
+                    confess
+                        "The method ($curried_name) already ".
+                        "exists in class (" . $class->name . ")";
+                }
+                $method_code = $attr->_curry(
+                    $method_constructors->{$constructor}->(
+                        $attr,
+                        $attr_reader,
+                        $attr_writer,
+                    ), @$curried_args,
+                ),
+                my $method = MooseX::AttributeHelpers::Meta::Method::Curried->wrap(
+                    $method_code,
+                    package_name => $class_name,
+                    name => $curried_name,
+                );
+                
+                $attr->associate_method($method);
+                $class->add_method($curried_name => $method);
+            }
+        }
+        elsif (ref $constructed eq 'CODE') {
+#            my $method = MooseX::AttributeHelpers::Meta::Method::Curried->wrap(
+#                $attr->_curry($method_constructors->{$key}->(
+#                    $attr,
+#                    $attr_reader,
+#                    $attr_writer,
+#                ), @curried_args),
+#                package_name => $class_name,
+#                name => $curried_name,
+#            );
+        }
+        else {
+            confess "curries parameter must be ref type HASH or CODE";
         }
-
-        my $method = MooseX::AttributeHelpers::Meta::Method::Curried->wrap(
-            $attr->_curry($method_constructors->{$key}->(
-                $attr,
-                $attr_reader,
-                $attr_writer,
-            ), @curried_args),
-            package_name => $class_name,
-            name => $curried_name,
-        );
-        
-#use DDS; warn Dump($method);
-
-        $attr->associate_method($method);
-        $class->add_method($curried_name => $method);
     }
 
     foreach my $key (keys %{$attr->provides}) {
index 8e81b10..8aab0a4 100644 (file)
@@ -31,8 +31,12 @@ BEGIN {
             'clear'   => 'clear_options',        
         },
         curries   => {
-            'push'       => ['add_options_with_speed', 'funrolls', 'funbuns'],
-            'unshift'    => ['prepend_prerequisites_along_with', 'first', 'second']
+            'push'    => {
+                add_options_with_speed => ['funrolls', 'funbuns']
+            },
+            'unshift'  => {
+                prepend_prerequisites_along_with => ['first', 'second']
+            }
         }
     );
 }
index 70886ae..5f29544 100644 (file)
@@ -29,10 +29,9 @@ BEGIN {
             'delete' => 'delete_option',
         },
         curries   => {
-            'set'    => [
-                'set_with_defaults' =>
-                    size => 'medium', quantity => 1
-            ],
+            'set'    => {
+                set_quantity => ['quantity']
+            },
         }
     );
 }
@@ -100,10 +99,10 @@ $stuff->clear_options;
 is_deeply($stuff->options, { }, "... cleared options" );
 
 lives_ok {
-    $stuff->set_with_defaults(foo => 'bar');
+    $stuff->set_quantity(4);
 } '... options added okay with defaults';
 
-is_deeply($stuff->options, {size => 'medium', quantity => 1, foo => 'bar'});
+is_deeply($stuff->options, {quantity => 4});
 
 lives_ok {
     Stuff->new(options => { foo => 'BAR' });
index 3e4fecc..f7e9b85 100644 (file)
@@ -1,5 +1,6 @@
 #!/usr/bin/perl
 
+
 use strict;
 use warnings;
 
@@ -19,19 +20,19 @@ BEGIN {
         isa       => 'Int',
         default   => sub { 5 },
         provides  => {
-            set => 'set',
-            add => 'add',
-            sub => 'sub',
-            mul => 'mul',
-            div => 'div',
-            mod => 'mod',
-            abs => 'abs',
+            set       => 'set',
+            add       => 'add',
+            sub       => 'sub',
+            mul       => 'mul',
+            div       => 'div',
+            mod       => 'mod',
+            abs       => 'abs',
         },
         curries   => {
-            'add'         => ['inc', 1],
-            'sub'         => ['dec', 1],
-            'mod'         => ['odd', 2],
-            'div'         => ['cut_in_half', 2]
+            add       => {inc         => [ 1 ]},
+            sub       => {dec         => [ 1 ]},
+            mod       => {odd         => [ 2 ]},
+            div       => {cut_in_half => [ 2 ]}
         }
     );
 }
index 79c4593..c1754b0 100644 (file)
@@ -30,9 +30,9 @@ BEGIN {
             'join'     => 'join_options',
         },
         curries   => {
-            'grep'     => ['less_than_five', sub { $_ < 5 }],
-            'map'      => ['up_by_one', sub { $_ + 1 }],
-            'join'     => ['dashify', '-']
+            'grep'     => {less_than_five => [ sub { $_ < 5 } ]},
+            'map'      => {up_by_one      => [ sub { $_ + 1 } ]},
+            'join'     => {dashify        => [ '-' ]}
         }
     );
 }
index 97a638f..42d5149 100644 (file)
@@ -29,9 +29,9 @@ BEGIN {
             clear   => 'clear_string',
         },
         curries  => {
-            append  => ['exclaim', '!'],
-            replace => ['capitalize_last', qr/(.)$/, sub { uc $1 }],
-            match   => ['invalid_number', qr/\D/]
+            append  => {exclaim         => [ '!' ]},
+            replace => {capitalize_last => [ qr/(.)$/, sub { uc $1 } ]},
+            match   => {invalid_number  => [ qr/\D/ ]}
         }
     );
 }