+++ /dev/null
-
-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<curried> methods.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=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 E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2007-2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-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<handled> methods.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=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 E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2007-2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+++ /dev/null
-
-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<provided> methods.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=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 E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2007-2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
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;
}
}
-sub delegation_metaclass {
- 'Moose::AttributeHelpers::Meta::Method::Delegation'
-}
-
before '_process_options' => sub {
my ($self, $name, $options) = @_;
$self->process_options_for_handles($options, $name);
}
+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;
use_ok('Moose::AttributeHelpers');
}
+my $sort;
{
package Stuff;
use Moose;
'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] } ] ],
}
);
}
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',
'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');
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');
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');
use strict;
use warnings;
-use Test::More tests => 35;
+use Test::More tests => 34;
use Test::Exception;
use Test::Moose 'does_ok';
use_ok('Moose::AttributeHelpers');
}
+my $sort;
+my $less;
+my $up;
{
package Stuff;
use Moose;
'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 ]);
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
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');
projects / gitmo/Moose.git / commitdiff