From: Jason May Date: Sun, 15 Jun 2008 19:07:37 +0000 (+0000) Subject: add Bool as an attribute helper X-Git-Tag: 0.16~55 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=063fae5ea7080c5bf1d13ef7c6ac3d42351ae3fd;p=gitmo%2FMooseX-AttributeHelpers.git add Bool as an attribute helper --- diff --git a/ChangeLog b/ChangeLog index bdbecc0..754ef60 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ Revision history for Perl extension MooseX-AttributeHelpers +0.10 + - add Bool as an attribute helper (thanks to jasonmay) + 0.09 Sat. May, 24, 2008 - remove Module::Build in favor of Module::Install diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm index 5dadf03..18c0b9e 100644 --- a/lib/MooseX/AttributeHelpers.pm +++ b/lib/MooseX/AttributeHelpers.pm @@ -9,6 +9,7 @@ use MooseX::AttributeHelpers::Meta::Method::Provided; use MooseX::AttributeHelpers::Counter; use MooseX::AttributeHelpers::Number; use MooseX::AttributeHelpers::String; +use MooseX::AttributeHelpers::Bool; use MooseX::AttributeHelpers::Collection::List; use MooseX::AttributeHelpers::Collection::Array; use MooseX::AttributeHelpers::Collection::Hash; diff --git a/lib/MooseX/AttributeHelpers/Bool.pm b/lib/MooseX/AttributeHelpers/Bool.pm new file mode 100644 index 0000000..ed94067 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/Bool.pm @@ -0,0 +1,123 @@ +package MooseX::AttributeHelpers::Bool; +use Moose; +use MooseX::AttributeHelpers::MethodProvider::Bool; + +our $VERSION = '0.02'; +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' +); + +no Moose; + +# register the alias ... +package # hide me from search.cpan.org + Moose::Meta::Attribute::Custom::Bool; +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 => 'Int', + 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 + +=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/MethodProvider/Bool.pm b/lib/MooseX/AttributeHelpers/MethodProvider/Bool.pm new file mode 100644 index 0000000..3d279f4 --- /dev/null +++ b/lib/MooseX/AttributeHelpers/MethodProvider/Bool.pm @@ -0,0 +1,84 @@ + +package MooseX::AttributeHelpers::MethodProvider::Bool; +use Moose::Role; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:STEVAN'; + +sub set : method { + my ($attr, $reader, $writer) = @_; + return sub { $writer->($_[0], 1) }; +} + +sub unset : method { + my ($attr, $reader, $writer) = @_; + return sub { $writer->($_[0], 0) }; +} + +sub toggle : method { + my ($attr, $reader, $writer) = @_; + return sub { $writer->($_[0], !$reader->($_[0])) }; +} + +sub not : method { + my ($attr, $reader, $writer) = @_; + return sub { !$reader->($_[0]) }; +} + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::AttributeHelpers::MethodProvider::Bool + +=head1 DESCRIPTION + +This is a role which provides the method generators for +L. + +=head1 METHODS + +=over 4 + +=item B + +=back + +=head1 PROVIDED METHODS + +=over 4 + +=item B + +=item B + +=item B + +=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 + +Jason May Ejason.a.may@gmail.comE + +=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/012_basic_bool.t b/t/012_basic_bool.t new file mode 100644 index 0000000..4946911 --- /dev/null +++ b/t/012_basic_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' => ( + 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; +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'; +