lib/MooseX/AttributeHelpers/Number.pm

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