lib/MooseX/AttributeHelpers/Trait/Number.pm

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