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