From: Jason May Date: Sat, 21 Jun 2008 05:30:49 +0000 (+0000) Subject: refactor curries usage X-Git-Tag: 0.16~51 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3656a0d769a430ae48626e24b560d2987a0ddc88;p=gitmo%2FMooseX-AttributeHelpers.git refactor curries usage --- diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm index 691e9ae..7815223 100644 --- a/lib/MooseX/AttributeHelpers.pm +++ b/lib/MooseX/AttributeHelpers.pm @@ -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 parameter. Available meta classes are: =head2 provides This points to a hashref that uses C for the keys and -C<['method', @args]> for the values. The method will be added to +C 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 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 diff --git a/lib/MooseX/AttributeHelpers/Base.pm b/lib/MooseX/AttributeHelpers/Base.pm index bc72738..8fd2d97 100644 --- a/lib/MooseX/AttributeHelpers/Base.pm +++ b/lib/MooseX/AttributeHelpers/Base.pm @@ -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}) { diff --git a/t/002_basic_array.t b/t/002_basic_array.t index 8e81b10..8aab0a4 100644 --- a/t/002_basic_array.t +++ b/t/002_basic_array.t @@ -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'] + } } ); } diff --git a/t/003_basic_hash.t b/t/003_basic_hash.t index 70886ae..5f29544 100644 --- a/t/003_basic_hash.t +++ b/t/003_basic_hash.t @@ -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' }); diff --git a/t/004_basic_number.t b/t/004_basic_number.t index 3e4fecc..f7e9b85 100644 --- a/t/004_basic_number.t +++ b/t/004_basic_number.t @@ -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 ]} } ); } diff --git a/t/005_basic_list.t b/t/005_basic_list.t index 79c4593..c1754b0 100644 --- a/t/005_basic_list.t +++ b/t/005_basic_list.t @@ -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 => [ '-' ]} } ); } diff --git a/t/007_basic_string.t b/t/007_basic_string.t index 97a638f..42d5149 100644 --- a/t/007_basic_string.t +++ b/t/007_basic_string.t @@ -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/ ]} } ); }