lib/MooseX/AttributeHelpers/Trait/Number.pm

   1 package MooseX::AttributeHelpers::Trait::Number;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.19';
   5 $VERSION = eval $VERSION;
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   8 with 'MooseX::AttributeHelpers::Trait::Base';
   9
  10 sub helper_type { 'Num' }
  11
  12 # NOTE:
  13 # we don't use the method provider for this
  14 # module since many of the names of the provied
  15 # methods would conflict with keywords
  16 # - SL
  17
  18 has 'method_constructors' => (
  19     is      => 'ro',
  20     isa     => 'HashRef',
  21     lazy    => 1,
  22     default => sub {
  23         return +{
  24             set => sub {
  25                 my ($attr, $reader, $writer) = @_;
  26                 return sub { $writer->($_[0], $_[1]) };
  27             },
  28             add => sub {
  29                 my ($attr, $reader, $writer) = @_;
  30                 return sub { $writer->($_[0], $reader->($_[0]) + $_[1]) };
  31             },
  32             sub => sub {
  33                 my ($attr, $reader, $writer) = @_;
  34                 return sub { $writer->($_[0], $reader->($_[0]) - $_[1]) };
  35             },
  36             mul => sub {
  37                 my ($attr, $reader, $writer) = @_;
  38                 return sub { $writer->($_[0], $reader->($_[0]) * $_[1]) };
  39             },
  40             div => sub {
  41                 my ($attr, $reader, $writer) = @_;
  42                 return sub { $writer->($_[0], $reader->($_[0]) / $_[1]) };
  43             },
  44             mod => sub {
  45                 my ($attr, $reader, $writer) = @_;
  46                 return sub { $writer->($_[0], $reader->($_[0]) % $_[1]) };
  47             },
  48             abs => sub {
  49                 my ($attr, $reader, $writer) = @_;
  50                 return sub { $writer->($_[0], abs($reader->($_[0])) ) };
  51             },
  52         }
  53     }
  54 );
  55
  56 no Moose::Role;
  57
  58 # register the alias ...
  59 package # hide me from search.cpan.org
  60     Moose::Meta::Attribute::Custom::Trait::Number;
  61 sub register_implementation { 'MooseX::AttributeHelpers::Trait::Number' }
  62
  63 1;
  64
  65 =pod
  66
  67 =head1 NAME
  68
  69 MooseX::AttributeHelpers::Number
  70
  71 =head1 SYNOPSIS
  72
  73   package Real;
  74   use Moose;
  75   use MooseX::AttributeHelpers;
  76
  77   has 'integer' => (
  78       metaclass => 'Number',
  79       is        => 'ro',
  80       isa       => 'Int',
  81       default   => sub { 5 },
  82       provides  => {
  83           set => 'set',
  84           add => 'add',
  85           sub => 'sub',
  86           mul => 'mul',
  87           div => 'div',
  88           mod => 'mod',
  89           abs => 'abs',
  90       }
  91   );
  92
  93   my $real = Real->new();
  94   $real->add(5); # same as $real->integer($real->integer + 5);
  95   $real->sub(2); # same as $real->integer($real->integer - 2);
  96
  97 =head1 DESCRIPTION
  98
  99 This provides a simple numeric attribute, which supports most of the
 100 basic math operations.
 101
 102 =head1 METHODS
 103
 104 =over 4
 105
 106 =item B<meta>
 107
 108 =item B<helper_type>
 109
 110 =item B<method_constructors>
 111
 112 =back
 113
 114 =head1 PROVIDED METHODS
 115
 116 It is important to note that all those methods do in place
 117 modification of the value stored in the attribute.
 118
 119 =over 4
 120
 121 =item I<set ($value)>
 122
 123 Alternate way to set the value.
 124
 125 =item I<add ($value)>
 126
 127 Adds the current value of the attribute to C<$value>.
 128
 129 =item I<sub ($value)>
 130
 131 Subtracts the current value of the attribute to C<$value>.
 132
 133 =item I<mul ($value)>
 134
 135 Multiplies the current value of the attribute to C<$value>.
 136
 137 =item I<div ($value)>
 138
 139 Divides the current value of the attribute to C<$value>.
 140
 141 =item I<mod ($value)>
 142
 143 Modulus the current value of the attribute to C<$value>.
 144
 145 =item I<abs>
 146
 147 Sets the current value of the attribute to its absolute value.
 148
 149 =back
 150
 151 =head1 BUGS
 152
 153 All complex software has bugs lurking in it, and this module is no
 154 exception. If you find a bug please either email me, or add the bug
 155 to cpan-RT.
 156
 157 =head1 AUTHOR
 158
 159 Robert Boone
 160
 161 =head1 COPYRIGHT AND LICENSE
 162
 163 Copyright 2007-2009 by Infinity Interactive, Inc.
 164
 165 L<http://www.iinteractive.com>
 166
 167 This library is free software; you can redistribute it and/or modify
 168 it under the same terms as Perl itself.
 169
 170 =cut