Commit | Line | Data |
22d869ff |
1 | |
2 | package MooseX::AttributeHelpers::Counter; |
3 | use Moose; |
22d869ff |
4 | |
5 | our $VERSION = '0.01'; |
6 | our $AUTHORITY = 'cpan:STEVAN'; |
7 | |
d26633fc |
8 | extends 'MooseX::AttributeHelpers::Base'; |
9 | |
10 | has '+method_constructors' => ( |
11 | default => sub { |
12 | return +{ |
13 | inc => sub { |
14 | my $attr = shift; |
15 | return sub { $attr->set_value($_[0], $attr->get_value($_[0]) + 1) }; |
16 | }, |
17 | dec => sub { |
18 | my $attr = shift; |
19 | return sub { $attr->set_value($_[0], $attr->get_value($_[0]) - 1) }; |
20 | }, |
21 | } |
22d869ff |
22 | } |
d26633fc |
23 | ); |
22d869ff |
24 | |
d26633fc |
25 | sub _process_options_for_provides { |
26 | my ($self, $options) = @_; |
27 | (exists $options->{isa}) |
28 | || confess "You must define a type with the Counter metaclass"; |
29 | |
30 | (find_type_constraint($options->{isa})->is_subtype_of('Num')) |
31 | || confess "The type constraint for a Counter must be a subtype of Num"; |
32 | } |
22d869ff |
33 | |
22d869ff |
34 | no Moose; |
22d869ff |
35 | |
36 | # register the alias ... |
37 | package Moose::Meta::Attribute::Custom::Counter; |
38 | sub register_implementation { 'MooseX::AttributeHelpers::Counter' } |
39 | |
40 | 1; |
41 | |
42 | __END__ |
43 | |
44 | =pod |
45 | |
46 | =head1 NAME |
47 | |
48 | MooseX::AttributeHelpers::Counter |
49 | |
50 | =head1 SYNOPSIS |
51 | |
52 | package MyHomePage; |
53 | use Moose; |
54 | |
55 | has 'counter' => ( |
56 | metaclass => 'Counter', |
57 | is => 'rw', |
58 | isa => 'Int', |
59 | default => sub { 0 }, |
60 | provides => { |
61 | inc => 'inc_counter', |
62 | } |
63 | ); |
64 | |
65 | my $page = MyHomePage->new(); |
66 | $page->inc_counter; # same as $page->counter($page->counter + 1); |
67 | |
68 | =head1 DESCRIPTION |
69 | |
70 | =head1 METHODS |
71 | |
72 | =head1 BUGS |
73 | |
74 | All complex software has bugs lurking in it, and this module is no |
75 | exception. If you find a bug please either email me, or add the bug |
76 | to cpan-RT. |
77 | |
78 | =head1 AUTHOR |
79 | |
80 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
81 | |
82 | =head1 COPYRIGHT AND LICENSE |
83 | |
84 | Copyright 2007 by Infinity Interactive, Inc. |
85 | |
86 | L<http://www.iinteractive.com> |
87 | |
88 | This library is free software; you can redistribute it and/or modify |
89 | it under the same terms as Perl itself. |
90 | |
91 | =cut |