From: Hans Dieter Pearcey Date: Thu, 25 Jun 2009 22:05:20 +0000 (-0400) Subject: make more tests pass, remove unnecessary meta method classes X-Git-Tag: 0.89_02~128 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=182814510cd4d7ddaf651a9e26fab61d0c0898a1;p=gitmo%2FMoose.git make more tests pass, remove unnecessary meta method classes --- diff --git a/lib/Moose/AttributeHelpers/Meta/Method/Curried.pm b/lib/Moose/AttributeHelpers/Meta/Method/Curried.pm deleted file mode 100644 index a576c28..0000000 --- a/lib/Moose/AttributeHelpers/Meta/Method/Curried.pm +++ /dev/null @@ -1,52 +0,0 @@ - -package Moose::AttributeHelpers::Meta::Method::Curried; -use Moose; - -our $VERSION = '0.19'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - -extends 'Moose::Meta::Method'; - -1; - -__END__ - -=pod - -=head1 NAME - -Moose::AttributeHelpers::Meta::Method::Curried - -=head1 DESCRIPTION - -This is an extension of Moose::Meta::Method to mark I methods. - -=head1 METHODS - -=over 4 - -=item B - -=back - -=head1 BUGS - -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. - -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2007-2009 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/Moose/AttributeHelpers/Meta/Method/Delegation.pm b/lib/Moose/AttributeHelpers/Meta/Method/Delegation.pm deleted file mode 100644 index 374e06b..0000000 --- a/lib/Moose/AttributeHelpers/Meta/Method/Delegation.pm +++ /dev/null @@ -1,51 +0,0 @@ -package Moose::AttributeHelpers::Meta::Method::Delegation; -use Moose; - -our $VERSION = '0.19'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - -extends 'Moose::Meta::Method::Delegation'; - -1; - -__END__ - -=pod - -=head1 NAME - -Moose::AttributeHelpers::Meta::Method::Delegation - -=head1 DESCRIPTION - -This is an extension of Moose::Meta::Method to mark I methods. - -=head1 METHODS - -=over 4 - -=item B - -=back - -=head1 BUGS - -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. - -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2007-2009 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/Moose/AttributeHelpers/Meta/Method/Provided.pm b/lib/Moose/AttributeHelpers/Meta/Method/Provided.pm deleted file mode 100644 index 2823836..0000000 --- a/lib/Moose/AttributeHelpers/Meta/Method/Provided.pm +++ /dev/null @@ -1,52 +0,0 @@ - -package Moose::AttributeHelpers::Meta::Method::Provided; -use Moose; - -our $VERSION = '0.19'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - -extends 'Moose::Meta::Method'; - -1; - -__END__ - -=pod - -=head1 NAME - -Moose::AttributeHelpers::Meta::Method::Provided - -=head1 DESCRIPTION - -This is an extension of Moose::Meta::Method to mark I methods. - -=head1 METHODS - -=over 4 - -=item B - -=back - -=head1 BUGS - -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. - -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2007-2009 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/Moose/AttributeHelpers/Trait/Base.pm b/lib/Moose/AttributeHelpers/Trait/Base.pm index 573ccb9..2b2a6a0 100644 --- a/lib/Moose/AttributeHelpers/Trait/Base.pm +++ b/lib/Moose/AttributeHelpers/Trait/Base.pm @@ -2,7 +2,6 @@ package Moose::AttributeHelpers::Trait::Base; use Moose::Role; use Moose::Util::TypeConstraints; -use Moose::AttributeHelpers::Meta::Method::Delegation; our $VERSION = '0.19'; $VERSION = eval $VERSION; @@ -63,10 +62,6 @@ sub process_options_for_handles { } } -sub delegation_metaclass { - 'Moose::AttributeHelpers::Meta::Method::Delegation' -} - before '_process_options' => sub { my ($self, $name, $options) = @_; $self->process_options_for_handles($options, $name); @@ -108,6 +103,32 @@ sub check_handles_values { } +around '_make_delegation_method' => sub { + my $next = shift; + my ($self, $handle_name, $method_to_call) = @_; + + my ($name, $curried_args) = @$method_to_call; + + $curried_args ||= []; + + my $method_constructors = $self->method_constructors; + + my $code = $method_constructors->{$name}->( + $self, + $self->get_read_method_ref, + $self->get_write_method_ref, + ); + + return $next->( + $self, + $handle_name, + sub { + my $instance = shift; + return $code->($instance, @$curried_args, @_); + }, + ); +}; + no Moose::Role; no Moose::Util::TypeConstraints; diff --git a/t/070_attribute_helpers/202_trait_array.t b/t/070_attribute_helpers/202_trait_array.t index a84fd5c..e4d7fc5 100644 --- a/t/070_attribute_helpers/202_trait_array.t +++ b/t/070_attribute_helpers/202_trait_array.t @@ -11,6 +11,7 @@ BEGIN { use_ok('Moose::AttributeHelpers'); } +my $sort; { package Stuff; use Moose; @@ -33,13 +34,12 @@ BEGIN { 'splice_options' => 'splice', 'sort_options_in_place' => 'sort_in_place', 'option_accessor' => 'accessor', - 'add_optons_with_speed' => + 'add_options_with_speed' => [ 'push' => ['funrolls', 'funbuns'] ], 'prepend_prerequisites_along_with' => [ 'unshift' => ['first', 'second'] ], 'descending_options' => - [ 'sort_in_place' => [ sub { $_[1] <=> $_[0] } ] ], - }, + [ 'sort_in_place' => [ $sort = sub { $_[1] <=> $_[0] } ] ], } ); } @@ -224,7 +224,7 @@ dies_ok { my $options = $stuff->meta->get_attribute('options'); does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::Array'); -is_deeply($options->handles, +is_deeply($options->handles, { 'add_options' => 'push', 'remove_last_option' => 'pop', 'remove_first_option' => 'shift', @@ -237,6 +237,12 @@ is_deeply($options->handles, 'splice_options' => 'splice', 'sort_options_in_place' => 'sort_in_place', 'option_accessor' => 'accessor', + 'add_options_with_speed' => + [ 'push' => ['funrolls', 'funbuns'] ], + 'prepend_prerequisites_along_with' => + [ 'unshift' => ['first', 'second'] ], + 'descending_options' => + [ 'sort_in_place' => [ $sort ] ], }, '... got the right handles mapping'); is($options->type_constraint->type_parameter, 'Str', '... got the right container type'); diff --git a/t/070_attribute_helpers/203_trait_hash.t b/t/070_attribute_helpers/203_trait_hash.t index edcc931..b6d8553 100644 --- a/t/070_attribute_helpers/203_trait_hash.t +++ b/t/070_attribute_helpers/203_trait_hash.t @@ -136,18 +136,18 @@ my $options = $stuff->meta->get_attribute('options'); does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::Hash'); is_deeply($options->handles, { - 'add_options' => 'push', - 'remove_last_option' => 'pop', - 'remove_first_option' => 'shift', - 'insert_options' => 'unshift', - 'get_option_at' => 'get', - 'set_option_at' => 'set', - 'num_options' => 'count', - 'has_options' => 'empty', - 'clear_options' => 'clear', - 'splice_options' => 'splice', - 'sort_options_in_place' => 'sort_in_place', - 'option_accessor' => 'accessor', + 'set_option' => 'set', + 'get_option' => 'get', + 'has_options' => 'empty', + 'num_options' => 'count', + 'clear_options' => 'clear', + 'delete_option' => 'delete', + 'has_option' => 'exists', + 'is_defined' => 'defined', + 'option_accessor' => 'accessor', + 'key_value' => 'kv', + 'options_elements' => 'elements', + 'quantity' => [ accessor => ['quantity'] ], }, '... got the right handles mapping'); is($options->type_constraint->type_parameter, 'Str', '... got the right container type'); diff --git a/t/070_attribute_helpers/204_trait_number.t b/t/070_attribute_helpers/204_trait_number.t index f261201..4ad077c 100644 --- a/t/070_attribute_helpers/204_trait_number.t +++ b/t/070_attribute_helpers/204_trait_number.t @@ -104,5 +104,9 @@ is_deeply($attr->handles, { div => 'div', mod => 'mod', abs => 'abs', + inc => [ add => [ 1 ] ], + dec => [ sub => [ 1 ] ], + odd => [ mod => [ 2 ] ], + cut_in_half => [ div => [ 2 ] ], }, '... got the right handles mapping'); diff --git a/t/070_attribute_helpers/205_trait_list.t b/t/070_attribute_helpers/205_trait_list.t index 844b87c..c126b74 100644 --- a/t/070_attribute_helpers/205_trait_list.t +++ b/t/070_attribute_helpers/205_trait_list.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 35; +use Test::More tests => 34; use Test::Exception; use Test::Moose 'does_ok'; @@ -11,6 +11,9 @@ BEGIN { use_ok('Moose::AttributeHelpers'); } +my $sort; +my $less; +my $up; { package Stuff; use Moose; @@ -33,24 +36,13 @@ BEGIN { 'get_first_option' => 'first', 'get_last_option' => 'last', 'sorted_options' => 'sort', - 'less_than_five' => [ grep => [ sub { $_ < 5 } ] ], - 'up_by_one' => [ map => [ sub { $_ + 1 } ] ], + 'less_than_five' => [ grep => [ $less = sub { $_ < 5 } ] ], + 'up_by_one' => [ map => [ $up = sub { $_ + 1 } ] ], 'dashify' => [ join => [ '-' ] ], - 'descending' => [ sort => [ sub { $_[1] <=> $_[0] ] ], + 'descending' => [ sort => [ $sort = sub { $_[1] <=> $_[0] } ] ], }, ); - has animals => ( - is => 'rw', - isa => 'ArrayRef[Str]', - metaclass => 'Collection::List', - handles => { - double_length_of => [ grep => [ sub { - my ($self, $body, $arg) = @_; - $body->($self, sub { length($_) == length($arg) * 2 }); - } ] ], - } - ) } my $stuff = Stuff->new(options => [ 1 .. 10 ]); @@ -110,15 +102,6 @@ is_deeply([ $stuff->up_by_one() ], [2 .. 11]); is($stuff->dashify, '1-2-3-4-5-6-7-8-9-10'); -$stuff->animals([ qw/cat duck horse cattle gorilla elephant flamingo kangaroo/ ]); - -# 4 * 2 = 8 -is_deeply( - [ sort $stuff->double_length_of('fish') ], - [ sort qw/elephant flamingo kangaroo/ ], - 'returns all elements with double length of string "fish"' -); - is_deeply([$stuff->descending], [reverse 1 .. 10]); ## test the meta @@ -127,21 +110,21 @@ my $options = $stuff->meta->get_attribute('_options'); does_ok($options, 'Moose::AttributeHelpers::Trait::Collection::List'); is_deeply($options->handles, { - 'num_options' => 'count', - 'has_options' => 'empty', - 'map_options', => 'map', - 'filter_options' => 'grep', - 'find_option' => 'find', - 'options' => 'elements', - 'join_options' => 'join', - 'get_option_at' => 'get', - 'get_first_option' => 'first', - 'get_last_option' => 'last', - 'sorted_options' => 'sort', - 'less_than_five' => [ grep ], - 'up_by_one' => [ map ], - 'dashify' => [ join ], - 'descending' => [ sort ], + 'num_options' => 'count', + 'has_options' => 'empty', + 'map_options', => 'map', + 'filter_options' => 'grep', + 'find_option' => 'find', + 'options' => 'elements', + 'join_options' => 'join', + 'get_option_at' => 'get', + 'get_first_option' => 'first', + 'get_last_option' => 'last', + 'sorted_options' => 'sort', + 'less_than_five' => [ grep => [ $less ] ], + 'up_by_one' => [ map => [ $up ] ], + 'dashify' => [ join => [ '-' ] ], + 'descending' => [ sort => [ $sort ] ], }, '... got the right handles mapping'); is($options->type_constraint->type_parameter, 'Int', '... got the right container type');