local-lib5/lib/perl5/Moose/Meta/Attribute/Native/Trait/Number.pm

   1 package Moose::Meta::Attribute::Native::Trait::Number;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.93';
   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 - Helper trait for Num attributes
  62
  63 =head1 SYNOPSIS
  64
  65   package Real;
  66   use Moose;
  67
  68   has 'integer' => (
  69       traits    => ['Number'],
  70       is        => 'ro',
  71       isa       => 'Num',
  72       default   => 5,
  73       handles   => {
  74           set => 'set',
  75           add => 'add',
  76           sub => 'sub',
  77           mul => 'mul',
  78           div => 'div',
  79           mod => 'mod',
  80           abs => 'abs',
  81       },
  82   );
  83
  84   my $real = Real->new();
  85   $real->add(5); # same as $real->integer($real->integer + 5);
  86   $real->sub(2); # same as $real->integer($real->integer - 2);
  87
  88 =head1 DESCRIPTION
  89
  90 This provides a simple numeric attribute, which supports most of the
  91 basic math operations.
  92
  93 =head1 PROVIDED METHODS
  94
  95 It is important to note that all those methods do in place modification of the
  96 value stored in the attribute. These methods are implemented within this
  97 package.
  98
  99 =over 4
 100
 101 =item B<set($value)>
 102
 103 Alternate way to set the value.
 104
 105 =item B<add($value)>
 106
 107 Adds the current value of the attribute to C<$value>.
 108
 109 =item B<sub($value)>
 110
 111 Subtracts C<$value> from the current value of the attribute.
 112
 113 =item B<mul($value)>
 114
 115 Multiplies the current value of the attribute by C<$value>.
 116
 117 =item B<div($value)>
 118
 119 Divides the current value of the attribute by C<$value>.
 120
 121 =item B<mod($value)>
 122
 123 Returns the current value of the attribute modulo C<$value>.
 124
 125 =item B<abs>
 126
 127 Sets the current value of the attribute to its absolute value.
 128
 129 =back
 130
 131 =head1 METHODS
 132
 133 =over 4
 134
 135 =item B<meta>
 136
 137 =item B<method_constructors>
 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