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 Moose::Meta::Attribute::Custom::Number;
  56 sub register_implementation { 'MooseX::AttributeHelpers::Number' }
  57
  58 1;
  59
  60 =pod
  61
  62 =head1 NAME
  63
  64 MooseX::AttributeHelpers::Number
  65
  66 =head1 SYNOPSIS
  67
  68   package Real;
  69   use Moose;
  70   use MooseX::AttributeHelpers;
  71
  72   has 'integer' => (
  73       metaclass => 'Number',
  74       is        => 'ro',
  75       isa       => 'Int',
  76       default   => sub { 5 },
  77       provides  => {
  78           set => 'set',
  79           add => 'add',
  80           sub => 'sub',
  81           mul => 'mul',
  82           div => 'div',
  83           mod => 'mod',
  84           abs => 'abs',
  85       }
  86   );
  87
  88   my $real = Real->new();
  89   $real->add(5); # same as $real->integer($real->integer + 5);
  90   $real->sub(2); # same as $real->integer($real->integer - 2);
  91
  92 =head1 DESCRIPTION
  93
  94 This provides a simple numeric attribute, which supports most of the
  95 basic math operations.
  96
  97 =head1 METHODS
  98
  99 =over 4
 100
 101 =item B<meta>
 102
 103 =item B<helper_type>
 104
 105 =item B<method_constructors>
 106
 107 =back
 108
 109 =head1 PROVIDED METHODS
 110
 111 It is important to note that all those methods do in place
 112 modification of the value stored in the attribute.
 113
 114 =over 4
 115
 116 =item I<set ($value)>
 117
 118 Alternate way to set the value.
 119
 120 =item I<add ($value)>
 121
 122 Adds the current value of the attribute to C<$value>.
 123
 124 =item I<sub ($value)>
 125
 126 Subtracts the current value of the attribute to C<$value>.
 127
 128 =item I<mul ($value)>
 129
 130 Multiplies the current value of the attribute to C<$value>.
 131
 132 =item I<div ($value)>
 133
 134 Divides the current value of the attribute to C<$value>.
 135
 136 =item I<mod ($value)>
 137
 138 Modulus the current value of the attribute to C<$value>.
 139
 140 =item I<abs>
 141
 142 Sets the current value of the attribute to its absolute value.
 143
 144 =back
 145
 146 =head1 BUGS
 147
 148 All complex software has bugs lurking in it, and this module is no
 149 exception. If you find a bug please either email me, or add the bug
 150 to cpan-RT.
 151
 152 =head1 AUTHOR
 153
 154 Robert Boone
 155
 156 =head1 COPYRIGHT AND LICENSE
 157
 158 Copyright 2007 by Infinity Interactive, Inc.
 159
 160 L<http://www.iinteractive.com>
 161
 162 This library is free software; you can redistribute it and/or modify
 163 it under the same terms as Perl itself.
 164
 165 =cut