lib/MooseX/AttributeHelpers/Counter.pm

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