lib/MooseX/AttributeHelpers/Number.pm

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