From: Robert Boone <robo4288@gmail.com>
Date: Tue, 22 May 2007 02:41:58 +0000 (+0000)
Subject: Added MooseX::AttributeHelpers::Number
X-Git-Tag: 0.18_01~83
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=565fe2381a5f4c86660f0d2040ec9ebe7f7548b9;p=gitmo%2FMooseX-AttributeHelpers.git

Added MooseX::AttributeHelpers::Number
---

diff --git a/lib/MooseX/AttributeHelpers.pm b/lib/MooseX/AttributeHelpers.pm
index 31370bb..f713e3a 100644
--- a/lib/MooseX/AttributeHelpers.pm
+++ b/lib/MooseX/AttributeHelpers.pm
@@ -5,6 +5,7 @@ our $VERSION   = '0.01';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use MooseX::AttributeHelpers::Counter;
+use MooseX::AttributeHelpers::Number;
 use MooseX::AttributeHelpers::Collection::Array;
 use MooseX::AttributeHelpers::Collection::Hash;
 
diff --git a/lib/MooseX/AttributeHelpers/Number.pm b/lib/MooseX/AttributeHelpers/Number.pm
new file mode 100644
index 0000000..eb03977
--- /dev/null
+++ b/lib/MooseX/AttributeHelpers/Number.pm
@@ -0,0 +1,110 @@
+package MooseX::AttributeHelpers::Number;
+use Moose;
+use Moose::Util::TypeConstraints;
+
+our $VERSION   = '0.01';
+our $AUTHORITY = 'cpan:STEVAN';
+
+extends 'MooseX::AttributeHelpers::Base';
+
+sub helper_type { 'Num' }
+
+has '+method_constructors' => (
+    default => sub {
+        return +{
+            set => sub {
+                my $attr = shift;
+                return sub { $attr->set_value($_[0], $_[1]) };
+            },
+            add => sub {
+                my $attr = shift;
+                return sub { $attr->set_value($_[0], $attr->get_value($_[0]) + $_[1]) };
+            },
+            sub => sub {
+                my $attr = shift;
+                return sub { $attr->set_value($_[0], $attr->get_value($_[0]) - $_[1]) };
+            },
+            mul => sub {
+                my $attr = shift;
+                return sub { $attr->set_value($_[0], $attr->get_value($_[0]) * $_[1]) };
+            },
+            div => sub {
+                my $attr = shift;
+                return sub { $attr->set_value($_[0], $attr->get_value($_[0]) / $_[1]) };
+            },
+            mod => sub {
+                my $attr = shift;
+                return sub { $attr->set_value($_[0], abs($attr->get_value($_[0]) % $_[1])) };
+            },
+            abs => sub {
+                my $attr = shift;
+                return sub { $attr->set_value($_[0], abs($attr->get_value($_[0])) ) };
+            },
+        }
+    }
+);
+    
+no Moose;
+no Moose::Util::TypeConstraints;
+
+# register the alias ...
+package Moose::Meta::Attribute::Custom::Number;
+sub register_implementation { 'MooseX::AttributeHelpers::Number' }
+
+1;
+
+=pod
+
+=head1 NAME
+
+MooseX::AttributeHelpers::Number
+
+=head1 SYNOPSIS
+  
+  package Real;
+   use Moose;
+
+   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
+
+=head1 METHODS
+
+=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
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007 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
\ No newline at end of file
diff --git a/t/004_basic_number.t b/t/004_basic_number.t
new file mode 100644
index 0000000..219e21e
--- /dev/null
+++ b/t/004_basic_number.t
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More no_plan => 1;
+
+BEGIN {
+    use_ok('MooseX::AttributeHelpers');   
+}
+
+{
+    package Real;
+    use Moose;
+
+    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;
+
+is $real->integer, 5, 'Default to five';
+
+$real->add(10);
+
+is $real->integer, 15, 'Add ten for fithteen';
+
+$real->sub(3);
+
+is $real->integer, 12, 'Subtract three for 12';
+
+$real->set(10);
+
+is $real->integer, 10, 'Set to ten';
+
+$real->div(2);
+
+is $real->integer, 5, 'divide by 2';
+
+$real->mul(2);
+
+is $real->integer, 10, 'multiplied by 2';
+
+$real->mod(2);
+
+is $real->integer, 0, 'Mod by 2';
+
+$real->set(7);
+
+$real->mod(5);
+
+is $real->integer, 2, 'Mod by 5';
+
+$real->set(-1);
+
+$real->abs;
+
+is $real->integer, 1, 'abs 1'
\ No newline at end of file
diff --git a/t/100_collection_with_roles.t b/t/100_collection_with_roles.t
index 025e5c6..88e60c5 100644
--- a/t/100_collection_with_roles.t
+++ b/t/100_collection_with_roles.t
@@ -9,9 +9,6 @@ BEGIN {
     use_ok('MooseX::AttributeHelpers');
 }
 
-## convert this to a test ... 
-## code by Robert Boone
-
 package Subject;
 
 use Moose::Role;