set => 'set_mapping',
},
curries => {
- set => [ set_quantity => 'quantity' ]
+ set => { set_quantity => [ 'quantity' ] }
}
);
=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
my $self = shift;
my $code = shift;
- #warn "_curry: "; use DDS; warn Dump($self);
my @args = @_;
return sub { my $self = shift; $code->($self, @args, @_) };
}
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}) {
'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']
+ }
}
);
}
'delete' => 'delete_option',
},
curries => {
- 'set' => [
- 'set_with_defaults' =>
- size => 'medium', quantity => 1
- ],
+ 'set' => {
+ set_quantity => ['quantity']
+ },
}
);
}
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' });
#!/usr/bin/perl
+
use strict;
use warnings;
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 ]}
}
);
}
'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 => [ '-' ]}
}
);
}
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/ ]}
}
);
}