From: Shawn M Moore <sartak@gmail.com>
Date: Sun, 25 May 2008 01:15:45 +0000 (+0000)
Subject: MooseX::AttributeHelpers::Trait::Number
X-Git-Tag: 0.18_01~23
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e9d1a9c4eeddd11ae64acd23185034ef4aebc333;p=gitmo%2FMooseX-AttributeHelpers.git

MooseX::AttributeHelpers::Trait::Number
---

diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm
index 2ebc28c..906f659 100644
--- a/lib/MooseX/AttributeHelpers.pm
+++ b/lib/MooseX/AttributeHelpers.pm
@@ -7,6 +7,7 @@ our $AUTHORITY = 'cpan:STEVAN';
 use MooseX::AttributeHelpers::Meta::Method::Provided;
 
 use MooseX::AttributeHelpers::Trait::Counter;
+use MooseX::AttributeHelpers::Trait::Number;
 
 use MooseX::AttributeHelpers::Counter;
 use MooseX::AttributeHelpers::Number;
diff --git a/lib/MooseX/AttributeHelpers/Trait/Number.pm b/lib/MooseX/AttributeHelpers/Trait/Number.pm
new file mode 100644
index 0000000..85bd6fd
--- /dev/null
+++ b/lib/MooseX/AttributeHelpers/Trait/Number.pm
@@ -0,0 +1,170 @@
+package MooseX::AttributeHelpers::Trait::Number;
+use Moose::Role;
+
+our $VERSION   = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
+
+with 'MooseX::AttributeHelpers::Trait::Base';
+
+sub helper_type { 'Num' }
+
+# NOTE:
+# we don't use the method provider for this 
+# module since many of the names of the provied
+# methods would conflict with keywords
+# - SL
+
+has 'method_constructors' => (
+    is      => 'ro',
+    isa     => 'HashRef',
+    lazy    => 1,
+    default => sub {
+        return +{
+            set => sub {
+                my ($attr, $reader, $writer) = @_;
+                return sub { $writer->($_[0], $_[1]) };
+            },
+            add => sub {
+                my ($attr, $reader, $writer) = @_;
+                return sub { $writer->($_[0], $reader->($_[0]) + $_[1]) };
+            },
+            sub => sub {
+                my ($attr, $reader, $writer) = @_;
+                return sub { $writer->($_[0], $reader->($_[0]) - $_[1]) };
+            },
+            mul => sub {
+                my ($attr, $reader, $writer) = @_;
+                return sub { $writer->($_[0], $reader->($_[0]) * $_[1]) };
+            },
+            div => sub {
+                my ($attr, $reader, $writer) = @_;
+                return sub { $writer->($_[0], $reader->($_[0]) / $_[1]) };
+            },
+            mod => sub {
+                my ($attr, $reader, $writer) = @_;
+                return sub { $writer->($_[0], $reader->($_[0]) % $_[1]) };
+            },
+            abs => sub {
+                my ($attr, $reader, $writer) = @_;
+                return sub { $writer->($_[0], abs($reader->($_[0])) ) };
+            },
+        }
+    }
+);
+    
+no Moose::Role;
+
+# register the alias ...
+package # hide me from search.cpan.org
+    Moose::Meta::Attribute::Custom::Trait::Number;
+sub register_implementation { 'MooseX::AttributeHelpers::Trait::Number' }
+
+1;
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::Number
+
+=head1 SYNOPSIS
+  
+  package Real;
+  use Moose;
+  use MooseX::AttributeHelpers;
+  
+  has 'integer' => (
+      metaclass => 'Number',
+      is        => 'ro',
+      isa       => 'Int',
+      default   => sub { 5 },
+      provides  => {
+          set => 'set',
+          add => 'add',
+          sub => 'sub',
+          mul => 'mul',
+          div => 'div',
+          mod => 'mod',
+          abs => 'abs',
+      }
+  );
+
+  my $real = Real->new();
+  $real->add(5); # same as $real->integer($real->integer + 5);
+  $real->sub(2); # same as $real->integer($real->integer - 2);  
+  
+=head1 DESCRIPTION
+
+This provides a simple numeric attribute, which supports most of the
+basic math operations.
+
+=head1 METHODS
+
+=over 4
+
+=item B<meta>
+
+=item B<helper_type>
+
+=item B<method_constructors>
+
+=back
+
+=head1 PROVIDED METHODS
+
+It is important to note that all those methods do in place
+modification of the value stored in the attribute.
+
+=over 4
+
+=item I<set ($value)>
+
+Alternate way to set the value.
+
+=item I<add ($value)>
+
+Adds the current value of the attribute to C<$value>.
+
+=item I<sub ($value)>
+
+Subtracts the current value of the attribute to C<$value>.
+
+=item I<mul ($value)>
+
+Multiplies the current value of the attribute to C<$value>.
+
+=item I<div ($value)>
+
+Divides the current value of the attribute to C<$value>.
+
+=item I<mod ($value)>
+
+Modulus the current value of the attribute to C<$value>.
+
+=item I<abs>
+
+Sets the current value of the attribute to its absolute value.
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no 
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 AUTHOR
+
+Robert Boone
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2008 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+