From: Jesse Luehrs Date: Tue, 2 Jun 2009 00:04:18 +0000 (-0500) Subject: update the Bool attribute helper to be a trait X-Git-Tag: 0.18_01~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f4b22618bfaa39d74fedd0ed76d968beeac6039f;p=gitmo%2FMooseX-AttributeHelpers.git update the Bool attribute helper to be a trait --- diff --git a/lib/MooseX/AttributeHelpers/Bool.pm b/lib/MooseX/AttributeHelpers/Bool.pm index 957651c..84f9c39 100644 --- a/lib/MooseX/AttributeHelpers/Bool.pm +++ b/lib/MooseX/AttributeHelpers/Bool.pm @@ -1,33 +1,12 @@ package MooseX::AttributeHelpers::Bool; use Moose; -use MooseX::AttributeHelpers::MethodProvider::Bool; our $VERSION = '0.17'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; -extends 'MooseX::AttributeHelpers::Base'; - -sub helper_type { 'Bool' } - -# NOTE: -# we don't use the method provider for this -# module since many of the names of the provied -# methods would conflict with keywords -# - SL - -has '+method_provider' => ( - default => 'MooseX::AttributeHelpers::MethodProvider::Bool' -); - -before 'process_options_for_provides' => sub { - my ($self, $options, $name) = @_; - - # Set some default attribute options here unless already defined - if ((my $type = $self->helper_type) && !exists $options->{isa}){ - $options->{isa} = $type; - } -}; +extends 'Moose::Meta::Attribute'; +with 'MooseX::AttributeHelpers::Trait::Bool'; no Moose; @@ -37,101 +16,3 @@ package # hide me from search.cpan.org sub register_implementation { 'MooseX::AttributeHelpers::Bool' } 1; - -=pod - -=head1 NAME - -MooseX::AttributeHelpers::Bool - -=head1 SYNOPSIS - - package Room; - use Moose; - use MooseX::AttributeHelpers; - - has 'is_lit' => ( - metaclass => 'Bool', - is => 'rw', - isa => 'Bool', - default => sub { 0 }, - provides => { - set => 'illuminate', - unset => 'darken', - toggle => 'flip_switch', - not => 'is_dark' - } - ); - - my $room = Room->new(); - $room->illuminate; # same as $room->is_lit(1); - $room->darken; # same as $room->is_lit(0); - $room->flip_switch; # same as $room->is_lit(not $room->is_lit); - return $room->is_dark; # same as !$room->is_lit - -=head1 DESCRIPTION - -This provides a simple boolean attribute, which supports most of the -basic math operations. - -=head1 METHODS - -=over 4 - -=item B - -=item B - -=item B - -=item B - -=item B - -=back - -=head1 PROVIDED METHODS - -It is important to note that all those methods do in place -modification of the value stored in the attribute. - -=over 4 - -=item I - -Sets the value to C<1>. - -=item I - -Set the value to C<0>. - -=item I - -Toggle the value. If it's true, set to false, and vice versa. - -=item I - -Equivalent of 'not C<$value>'. - -=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 - -Jason May - -=head1 COPYRIGHT AND LICENSE - -Copyright 2007-2008 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/MooseX/AttributeHelpers/Trait/Bool.pm b/lib/MooseX/AttributeHelpers/Trait/Bool.pm new file mode 100644 index 0000000..c6a79e3 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Trait/Bool.pm @@ -0,0 +1,140 @@ +package MooseX::AttributeHelpers::Trait::Bool; +use Moose::Role; +use MooseX::AttributeHelpers::MethodProvider::Bool; + +our $VERSION = '0.17'; +$VERSION = eval $VERSION; +our $AUTHORITY = 'cpan:STEVAN'; + +with 'MooseX::AttributeHelpers::Trait::Base'; + +sub helper_type { 'Bool' } + +# NOTE: +# we don't use the method provider for this +# module since many of the names of the provied +# methods would conflict with keywords +# - SL + +has 'method_provider' => ( + is => 'ro', + isa => 'ClassName', + predicate => 'has_method_provider', + default => 'MooseX::AttributeHelpers::MethodProvider::Bool' +); + +before 'process_options_for_provides' => sub { + my ($self, $options, $name) = @_; + + # Set some default attribute options here unless already defined + if ((my $type = $self->helper_type) && !exists $options->{isa}){ + $options->{isa} = $type; + } +}; + +no Moose::Role; + +# register the alias ... +package # hide me from search.cpan.org + Moose::Meta::Attribute::Custom::Trait::Bool; +sub register_implementation { 'MooseX::AttributeHelpers::Trait::Bool' } + +1; + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::Bool + +=head1 SYNOPSIS + + package Room; + use Moose; + use MooseX::AttributeHelpers; + + has 'is_lit' => ( + metaclass => 'Bool', + is => 'rw', + isa => 'Bool', + default => sub { 0 }, + provides => { + set => 'illuminate', + unset => 'darken', + toggle => 'flip_switch', + not => 'is_dark' + } + ); + + my $room = Room->new(); + $room->illuminate; # same as $room->is_lit(1); + $room->darken; # same as $room->is_lit(0); + $room->flip_switch; # same as $room->is_lit(not $room->is_lit); + return $room->is_dark; # same as !$room->is_lit + +=head1 DESCRIPTION + +This provides a simple boolean attribute, which supports most of the +basic math operations. + +=head1 METHODS + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B + +=back + +=head1 PROVIDED METHODS + +It is important to note that all those methods do in place +modification of the value stored in the attribute. + +=over 4 + +=item I + +Sets the value to C<1>. + +=item I + +Set the value to C<0>. + +=item I + +Toggle the value. If it's true, set to false, and vice versa. + +=item I + +Equivalent of 'not C<$value>'. + +=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 + +Jason May + +=head1 COPYRIGHT AND LICENSE + +Copyright 2007-2008 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/t/208_trait_bool.t b/t/208_trait_bool.t new file mode 100644 index 0000000..4c0e36d --- /dev/null +++ b/t/208_trait_bool.t @@ -0,0 +1,42 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 8; +use MooseX::AttributeHelpers; + +{ + package Room; + use Moose; + has 'is_lit' => ( + traits => ['Bool'], + is => 'rw', + isa => 'Bool', + default => sub { 0 }, + provides => { + set => 'illuminate', + unset => 'darken', + toggle => 'flip_switch', + not => 'is_dark' + } + ) +} + +my $room = Room->new; +$room->illuminate; +ok $room->is_lit, 'set is_lit to 1 using ->illuminate'; +ok !$room->is_dark, 'check if is_dark does the right thing'; + +$room->darken; +ok !$room->is_lit, 'set is_lit to 0 using ->darken'; +ok $room->is_dark, 'check if is_dark does the right thing'; + +$room->flip_switch; +ok $room->is_lit, 'toggle is_lit back to 1 using ->flip_switch'; +ok !$room->is_dark, 'check if is_dark does the right thing'; + +$room->flip_switch; +ok !$room->is_lit, 'toggle is_lit back to 0 again using ->flip_switch'; +ok $room->is_dark, 'check if is_dark does the right thing'; +