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

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