lib/MooseX/AttributeHelpers/Number.pm

   1 package MooseX::AttributeHelpers::Number;
   2 use Moose;
   3 use Moose::Util::TypeConstraints;
   4
   5 our $VERSION   = '0.01';
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   8 extends 'MooseX::AttributeHelpers::Base';
   9
  10 sub helper_type { 'Num' }
  11
  12 has '+method_constructors' => (
  13     default => sub {
  14         return +{
  15             set => sub {
  16                 my $attr = shift;
  17                 return sub { $attr->set_value($_[0], $_[1]) };
  18             },
  19             add => sub {
  20                 my $attr = shift;
  21                 return sub { $attr->set_value($_[0], $attr->get_value($_[0]) + $_[1]) };
  22             },
  23             sub => sub {
  24                 my $attr = shift;
  25                 return sub { $attr->set_value($_[0], $attr->get_value($_[0]) - $_[1]) };
  26             },
  27             mul => sub {
  28                 my $attr = shift;
  29                 return sub { $attr->set_value($_[0], $attr->get_value($_[0]) * $_[1]) };
  30             },
  31             div => sub {
  32                 my $attr = shift;
  33                 return sub { $attr->set_value($_[0], $attr->get_value($_[0]) / $_[1]) };
  34             },
  35             mod => sub {
  36                 my $attr = shift;
  37                 return sub { $attr->set_value($_[0], abs($attr->get_value($_[0]) % $_[1])) };
  38             },
  39             abs => sub {
  40                 my $attr = shift;
  41                 return sub { $attr->set_value($_[0], abs($attr->get_value($_[0])) ) };
  42             },
  43         }
  44     }
  45 );
  46
  47 no Moose;
  48 no Moose::Util::TypeConstraints;
  49
  50 # register the alias ...
  51 package Moose::Meta::Attribute::Custom::Number;
  52 sub register_implementation { 'MooseX::AttributeHelpers::Number' }
  53
  54 1;
  55
  56 =pod
  57
  58 =head1 NAME
  59
  60 MooseX::AttributeHelpers::Number
  61
  62 =head1 SYNOPSIS
  63
  64   package Real;
  65    use Moose;
  66
  67    has 'integer' => (
  68        metaclass => 'Number',
  69        is        => 'ro',
  70        isa       => 'Int',
  71        default   => sub { 5 },
  72        provides  => {
  73            set => 'set',
  74            add => 'add',
  75            sub => 'sub',
  76            mul => 'mul',
  77            div => 'div',
  78            mod => 'mod',
  79            abs => 'abs',
  80        }
  81    );
  82
  83   my $real = Real->new();
  84   $real->add(5); # same as $real->integer($real->integer + 5);
  85   $real->sub(2); # same as $real->integer($real->integer - 2);
  86
  87 =head1 DESCRIPTION
  88
  89 =head1 METHODS
  90
  91 =head1 BUGS
  92
  93 All complex software has bugs lurking in it, and this module is no
  94 exception. If you find a bug please either email me, or add the bug
  95 to cpan-RT.
  96
  97 =head1 AUTHOR
  98
  99 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 100
 101 =head1 COPYRIGHT AND LICENSE
 102
 103 Copyright 2007 by Infinity Interactive, Inc.
 104
 105 L<http://www.iinteractive.com>
 106
 107 This library is free software; you can redistribute it and/or modify
 108 it under the same terms as Perl itself.
 109
 110 =cut