lib/MooseX/AttributeHelpers/Counter.pm

   1
   2 package MooseX::AttributeHelpers::Counter;
   3 use Moose;
   4
   5 our $VERSION   = '0.01';
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   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         }
  22     }
  23 );
  24
  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 }
  33
  34 no Moose;
  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