Bug #55318 for MooseX-ChainedAccessors: Provide a MooseX::ChainedAccessors package

On Sun Mar 07 16:18:37 2010, CYCLES wrote: Show quoted text
Hi, I have attached a patch to do just this - hope you find it OK!

diff --git a/Makefile.PL b/Makefile.PL index 51fe3a3..6e3969c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -3,9 +3,9 @@ use warnings; use inc::Module::Install; name 'MooseX-ChainedAccessors'; -all_from 'lib/MooseX/ChainedAccessors/Accessor.pm'; +all_from 'lib/MooseX/ChainedAccessors.pm'; requires 'Moose'; license 'Perl'; -WriteAll(); \ No newline at end of file +WriteAll(); diff --git a/lib/MooseX/ChainedAccessors.pm b/lib/MooseX/ChainedAccessors.pm new file mode 100644 index 0000000..4fe5181 --- /dev/null +++ b/lib/MooseX/ChainedAccessors.pm @@ -0,0 +1,66 @@ +use strict; +use warnings; + +package MooseX::ChainedAccessors; +our $VERSION = '0.01'; + +use MooseX::ChainedAccessors::Meta::Attribute::Trait; + +package # Don't index + Moose::Meta::Attribute::Custom::Trait::Chained; + +our $VERSION = '0.01'; + +sub register_implementation { 'MooseX::ChainedAccessors::Meta::Attribute::Trait' } + +1; + +=head1 NAME + +MooseX::ChainedAccessors - Accessor class for chained accessors with Moose + +=head1 SYNOPSIS + + package Test; + use Moose; + use MooseX::ChainedAccessors; + + has => 'debug' => ( + traits => [ 'Chained' ], + is => 'rw', + isa => 'Bool', + ); + + sub complex_method + { + my $self = shift; + + #... + + print "helper message" if $self->debug; + + #... + } + + + 1; + +Which allows for: + + my $test = Test->new(); + $test->debug(1)->complex_method(); + +=head1 DESCRIPTION + +MooseX::ChainedAccessors is a Moose Trait which allows for method chaining +on accessors by returning $self on write/set operations. + +=head1 AUTHORS + +David McLaughlin E<lt>david@dmclaughlin.comE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright 2009 David McLaughlin + +This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/MooseX/ChainedAccessors/Accessor.pm b/lib/MooseX/ChainedAccessors/Accessor.pm deleted file mode 100644 index 55924d0..0000000 --- a/lib/MooseX/ChainedAccessors/Accessor.pm +++ /dev/null @@ -1,109 +0,0 @@ -package MooseX::ChainedAccessors::Accessor; -use strict; -use warnings; - -use base 'Moose::Meta::Method::Accessor'; - -our $VERSION = '0.01'; - -sub _generate_accessor_method_inline { - my $self = $_[0]; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $inv = '$_[0]'; - my $slot_access = $self->_inline_access($inv, $attr_name); - my $value_name = $self->_value_needs_copy ? '$val' : '$_[1]'; - - $self->_eval_code('sub { ' . "\n" - . $self->_inline_pre_body(@_) . "\n" - . 'if (scalar(@_) >= 2) {' . "\n" - . $self->_inline_copy_value . "\n" - . $self->_inline_check_required . "\n" - . $self->_inline_check_coercion($value_name) . "\n" - . $self->_inline_check_constraint($value_name) . "\n" - . $self->_inline_store($inv, $value_name) . "\n" - . $self->_inline_trigger($inv, $value_name) . "\n" - . 'return $_[0]; ' . "\n" - . ' }' . "\n" - . $self->_inline_check_lazy($inv) . "\n" - . $self->_inline_post_body(@_) . "\n" - . 'return ' . $self->_inline_auto_deref($self->_inline_get($inv)) . "\n" - . ' }'); -} - -sub _generate_writer_method_inline { - my $self = $_[0]; - my $attr = $self->associated_attribute; - my $attr_name = $attr->name; - my $inv = '$_[0]'; - my $slot_access = $self->_inline_get($inv, $attr_name); - my $value_name = $self->_value_needs_copy ? '$val' : '$_[1]'; - - $self->_eval_code('sub { ' - . $self->_inline_pre_body(@_) - . $self->_inline_copy_value - . $self->_inline_check_required - . $self->_inline_check_coercion($value_name) - . $self->_inline_check_constraint($value_name) - . $self->_inline_store($inv, $value_name) - . $self->_inline_post_body(@_) - . $self->_inline_trigger($inv, $value_name) - . 'return $_[0]; ' . "\n" - . ' }'); -} - -1; - -__END__ - - -=head1 NAME - -MooseX::ChainedAccessors::Accessor - Accessor class for chained accessors with Moose - -=head1 SYNOPSIS - - package Test; - use Moose; - - has => 'debug' => ( - traits => [ 'Chained' ], - is => 'rw', - isa => 'Bool', - ); - - sub complex_method - { - my $self = shift; - - #... - - print "helper message" if $self->debug; - - #... - } - - - 1; - -Which allows for: - - my $test = Test->new(); - $test->debug(1)->complex_method(); - -=head1 DESCRIPTION - -MooseX::ChainedAccessors is a Moose Trait which allows for method chaining -on accessors by returning $self on write/set operations. - -=head1 AUTHORS - -David McLaughlin E<lt>david@dmclaughlin.comE<gt> - -=head1 COPYRIGHT AND LICENSE - -Copyright 2009 David McLaughlin - -This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - - diff --git a/lib/MooseX/ChainedAccessors/Meta/Accessor.pm b/lib/MooseX/ChainedAccessors/Meta/Accessor.pm new file mode 100644 index 0000000..6b66ebd --- /dev/null +++ b/lib/MooseX/ChainedAccessors/Meta/Accessor.pm @@ -0,0 +1,59 @@ +package MooseX::ChainedAccessors::Meta::Accessor; +use strict; +use warnings; + +use base 'Moose::Meta::Method::Accessor'; + +our $VERSION = '0.01'; + +sub _generate_accessor_method_inline { + my $self = $_[0]; + my $attr = $self->associated_attribute; + my $attr_name = $attr->name; + my $inv = '$_[0]'; + my $slot_access = $self->_inline_access($inv, $attr_name); + my $value_name = $self->_value_needs_copy ? '$val' : '$_[1]'; + + $self->_eval_code('sub { ' . "\n" + . $self->_inline_pre_body(@_) . "\n" + . 'if (scalar(@_) >= 2) {' . "\n" + . $self->_inline_copy_value . "\n" + . $self->_inline_check_required . "\n" + . $self->_inline_check_coercion($value_name) . "\n" + . $self->_inline_check_constraint($value_name) . "\n" + . $self->_inline_store($inv, $value_name) . "\n" + . $self->_inline_trigger($inv, $value_name) . "\n" + . 'return $_[0]; ' . "\n" + . ' }' . "\n" + . $self->_inline_check_lazy($inv) . "\n" + . $self->_inline_post_body(@_) . "\n" + . 'return ' . $self->_inline_auto_deref($self->_inline_get($inv)) . "\n" + . ' }'); +} + +sub _generate_writer_method_inline { + my $self = $_[0]; + my $attr = $self->associated_attribute; + my $attr_name = $attr->name; + my $inv = '$_[0]'; + my $slot_access = $self->_inline_get($inv, $attr_name); + my $value_name = $self->_value_needs_copy ? '$val' : '$_[1]'; + + $self->_eval_code('sub { ' + . $self->_inline_pre_body(@_) + . $self->_inline_copy_value + . $self->_inline_check_required + . $self->_inline_check_coercion($value_name) + . $self->_inline_check_constraint($value_name) + . $self->_inline_store($inv, $value_name) + . $self->_inline_post_body(@_) + . $self->_inline_trigger($inv, $value_name) + . 'return $_[0]; ' . "\n" + . ' }'); +} + +1; + +__END__ + + diff --git a/lib/MooseX/ChainedAccessors/Meta/Attribute/Trait.pm b/lib/MooseX/ChainedAccessors/Meta/Attribute/Trait.pm new file mode 100644 index 0000000..e9aab8e --- /dev/null +++ b/lib/MooseX/ChainedAccessors/Meta/Attribute/Trait.pm @@ -0,0 +1,42 @@ +package MooseX::ChainedAccessors::Meta::Attribute::Trait; +use Moose::Role; +use MooseX::ChainedAccessors::Meta::Accessor; + +our $VERSION = '0.01'; + +sub accessor_metaclass { 'MooseX::ChainedAccessors::Meta::Accessor' } + +no Moose::Role; +1; + + +__END__ + +=head1 NAME + +MooseX::ChainedAccessors::Meta::Attribute::Trait - Create method chaining attributes + +=head1 SYNOPSIS + + has => 'debug' => ( + traits => [ 'Chained' ], + is => 'rw', + isa => 'Bool', + ); + +=head1 DESCRIPTION + +Modifies the Accessor Metaclass to use MooseX::ChainedAccessors::Accessor + +=head1 AUTHORS + +David McLaughlin E<lt>david@dmclaughlin.comE<gt> + +=head1 COPYRIGHT AND LICENSE + +Copyright 2009 David McLaughlin + +This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + + + diff --git a/lib/MooseX/Traits/Attribute/Chained.pm b/lib/MooseX/Traits/Attribute/Chained.pm deleted file mode 100644 index c89eaf1..0000000 --- a/lib/MooseX/Traits/Attribute/Chained.pm +++ /dev/null @@ -1,42 +0,0 @@ -package MooseX::Traits::Attribute::Chained; -use Moose::Role; -use MooseX::ChainedAccessors::Accessor; - -our $VERSION = '0.01'; - -sub accessor_metaclass { 'MooseX::ChainedAccessors::Accessor' } - -no Moose::Role; -1; - - -__END__ - -=head1 NAME - -MooseX::Traits::Attribute::Chained - Create method chaining attributes - -=head1 SYNOPSIS - - has => 'debug' => ( - traits => [ 'Chained' ], - is => 'rw', - isa => 'Bool', - ); - -=head1 DESCRIPTION - -Modifies the Accessor Metaclass to use MooseX::ChainedAccessors::Accessor - -=head1 AUTHORS - -David McLaughlin E<lt>david@dmclaughlin.comE<gt> - -=head1 COPYRIGHT AND LICENSE - -Copyright 2009 David McLaughlin - -This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - - - diff --git a/t/chained.t b/t/chained.t index 80381b9..801a713 100755 --- a/t/chained.t +++ b/t/chained.t @@ -2,30 +2,27 @@ use strict; use warnings; -use Test::More tests => 8; - -use_ok('Moose::Meta::Attribute::Custom::Trait::Chained'); -use_ok('MooseX::ChainedAccessors::Accessor'); -use_ok('MooseX::Traits::Attribute::Chained'); +use Test::More tests => 5; { package SimpleChained; use Moose; - + use MooseX::ChainedAccessors; + has 'regular_attr' => ( is => 'rw', isa => 'Str', default => sub { 'hello'; }, ); - + has 'chained_attr' => ( traits => ['Chained'], is => 'rw', - isa => 'Bool', + isa => 'Bool', lazy => 1, default => sub { 0; }, ); - + has 'writer_attr' => ( traits => ['Chained'], is => 'rw', @@ -44,7 +41,7 @@ is($simple->chained_attr(0)->set_writer_attr('world')->get_writer_attr, 'world', { package Debug; use Moose::Role; - + has 'debug' => ( traits => ['Chained'], is => 'rw', @@ -57,10 +54,10 @@ is($simple->chained_attr(0)->set_writer_attr('world')->get_writer_attr, 'world', { package ChainedFromRole; use Moose; - + with 'Debug'; - - sub message + + sub message { my $self = shift; return 'hello' if $self->debug; @@ -71,4 +68,4 @@ is($simple->chained_attr(0)->set_writer_attr('world')->get_writer_attr, 'world', my $rolechained = ChainedFromRole->new(); is($rolechained->message, 'world', 'normal access..'); is($rolechained->debug(1)->message, 'hello', 'chained write affects method call..'); -is($rolechained->debug, 1, 'chained attribute reads ok.'); \ No newline at end of file +is($rolechained->debug, 1, 'chained attribute reads ok.');