lib/MooseX/AttributeHelpers/Counter.pm

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