lib/Moose/Meta/Attribute/Trait/Native/Number.pm

   1 package Moose::Meta::Attribute::Trait::Native::Number;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.87';
   5 $VERSION = eval $VERSION;
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   8 with 'Moose::Meta::Attribute::Trait::Native::Base';
   9
  10 sub _helper_type { 'Num' }
  11
  12 # NOTE: we don't use the method provider for this module since many of
  13 # the names of the provided methods would conflict with keywords - SL
  14
  15 has 'method_constructors' => (
  16     is      => 'ro',
  17     isa     => 'HashRef',
  18     lazy    => 1,
  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::Role;
  54
  55 package # hide me from search.cpan.org
  56     Moose::Meta::Attribute::Custom::Trait::Number;
  57 sub register_implementation { 'Moose::Meta::Attribute::Trait::Native::Number' }
  58
  59 1;
  60
  61 =pod
  62
  63 =head1 NAME
  64
  65 Moose::Meta::Attribute::Trait::Native::Number
  66
  67 =head1 SYNOPSIS
  68
  69   package Real;
  70   use Moose;
  71   use Moose::AttributeHelpers;
  72
  73   has 'integer' => (
  74       metaclass => 'Number',
  75       is        => 'ro',
  76       isa       => 'Int',
  77       default   => 5,
  78       handles  => {
  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<method_constructors>
 105
 106 =back
 107
 108 =head1 PROVIDED METHODS
 109
 110 It is important to note that all those methods do in place
 111 modification of the value stored in the attribute.
 112
 113 =over 4
 114
 115 =item I<set ($value)>
 116
 117 Alternate way to set the value.
 118
 119 =item I<add ($value)>
 120
 121 Adds the current value of the attribute to C<$value>.
 122
 123 =item I<sub ($value)>
 124
 125 Subtracts the current value of the attribute to C<$value>.
 126
 127 =item I<mul ($value)>
 128
 129 Multiplies the current value of the attribute to C<$value>.
 130
 131 =item I<div ($value)>
 132
 133 Divides the current value of the attribute to C<$value>.
 134
 135 =item I<mod ($value)>
 136
 137 Modulus the current value of the attribute to C<$value>.
 138
 139 =item I<abs>
 140
 141 Sets the current value of the attribute to its absolute value.
 142
 143 =back
 144
 145 =head1 BUGS
 146
 147 All complex software has bugs lurking in it, and this module is no
 148 exception. If you find a bug please either email me, or add the bug
 149 to cpan-RT.
 150
 151 =head1 AUTHOR
 152
 153 Robert Boone
 154
 155 =head1 COPYRIGHT AND LICENSE
 156
 157 Copyright 2007-2009 by Infinity Interactive, Inc.
 158
 159 L<http://www.iinteractive.com>
 160
 161 This library is free software; you can redistribute it and/or modify
 162 it under the same terms as Perl itself.
 163
 164 =cut