lib/Moose/AttributeHelpers/Trait/Counter.pm

   1
   2 package Moose::AttributeHelpers::Trait::Counter;
   3 use Moose::Role;
   4
   5 our $VERSION   = '0.85';
   6 $VERSION = eval $VERSION;
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   9 use Moose::AttributeHelpers::MethodProvider::Counter;
  10
  11 with 'Moose::AttributeHelpers::Trait::Base';
  12
  13 has 'method_provider' => (
  14     is        => 'ro',
  15     isa       => 'ClassName',
  16     predicate => 'has_method_provider',
  17     default   => 'Moose::AttributeHelpers::MethodProvider::Counter',
  18 );
  19
  20 sub helper_type { 'Num' }
  21
  22 before 'process_options_for_handles' => sub {
  23     my ( $self, $options, $name ) = @_;
  24
  25     # Set some default attribute options here unless already defined
  26     if ( ( my $type = $self->helper_type ) && !exists $options->{isa} ) {
  27         $options->{isa} = $type;
  28     }
  29
  30     $options->{is}      = 'ro' unless exists $options->{is};
  31     $options->{default} = 0    unless exists $options->{default};
  32 };
  33
  34 after 'check_handles_values' => sub {
  35     my $self    = shift;
  36     my $handles = $self->handles;
  37
  38     unless ( scalar keys %$handles ) {
  39         my $method_constructors = $self->method_constructors;
  40         my $attr_name           = $self->name;
  41
  42         foreach my $method ( keys %$method_constructors ) {
  43             $handles->{ $method . '_' . $attr_name } = $method;
  44         }
  45
  46         $self->_set_handles($handles);
  47     }
  48 };
  49
  50 no Moose::Role;
  51
  52 # register the alias ...
  53 package # hide me from search.cpan.org
  54     Moose::Meta::Attribute::Custom::Trait::Counter;
  55 sub register_implementation { 'Moose::AttributeHelpers::Trait::Counter' }
  56
  57 1;
  58
  59 __END__
  60
  61 =pod
  62
  63 =head1 NAME
  64
  65 Moose::AttributeHelpers::Counter
  66
  67 =head1 SYNOPSIS
  68
  69   package MyHomePage;
  70   use Moose;
  71   use Moose::AttributeHelpers;
  72
  73   has 'counter' => (
  74       metaclass => 'Counter',
  75       is        => 'ro',
  76       isa       => 'Num',
  77       default   => sub { 0 },
  78       handles   => {
  79           inc_counter   => 'inc',
  80           dec_counter   => 'dec',
  81           reset_counter => 'reset',
  82       }
  83   );
  84
  85   my $page = MyHomePage->new();
  86   $page->inc_counter; # same as $page->counter($page->counter + 1);
  87   $page->dec_counter; # same as $page->counter($page->counter - 1);
  88
  89 =head1 DESCRIPTION
  90
  91 This module provides a simple counter attribute, which can be
  92 incremented and decremented.
  93
  94 If your attribute definition does not include any of I<is>, I<isa>,
  95 I<default> or I<handles> but does use the C<Counter> metaclass,
  96 then this module applies defaults as in the L</SYNOPSIS>
  97 above. This allows for a very basic counter definition:
  98
  99   has 'foo' => (metaclass => 'Counter');
 100   $obj->inc_foo;
 101
 102 =head1 METHODS
 103
 104 =over 4
 105
 106 =item B<meta>
 107
 108 =item B<method_provider>
 109
 110 =item B<has_method_provider>
 111
 112 =item B<helper_type>
 113
 114 =item B<process_options_for_handles>
 115
 116 Run before its superclass method.
 117
 118 =item B<check_handles_values>
 119
 120 Run after its superclass method.
 121
 122 =back
 123
 124 =head1 PROVIDED METHODS
 125
 126 It is important to note that all those methods do in place
 127 modification of the value stored in the attribute.
 128
 129 =over 4
 130
 131 =item I<set>
 132
 133 Set the counter to the specified value.
 134
 135 =item I<inc>
 136
 137 Increments the value stored in this slot by 1. Providing an argument will
 138 cause the counter to be increased by specified amount.
 139
 140 =item I<dec>
 141
 142 Decrements the value stored in this slot by 1. Providing an argument will
 143 cause the counter to be increased by specified amount.
 144
 145 =item I<reset>
 146
 147 Resets the value stored in this slot to it's default value.
 148
 149 =back
 150
 151 =head1 BUGS
 152
 153 All complex software has bugs lurking in it, and this module is no
 154 exception. If you find a bug please either email me, or add the bug
 155 to cpan-RT.
 156
 157 =head1 AUTHOR
 158
 159 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 160
 161 =head1 COPYRIGHT AND LICENSE
 162
 163 Copyright 2007-2009 by Infinity Interactive, Inc.
 164
 165 L<http://www.iinteractive.com>
 166
 167 This library is free software; you can redistribute it and/or modify
 168 it under the same terms as Perl itself.
 169
 170 =cut