lib/MooseX/AttributeHelpers/Base.pm

   1
   2 package MooseX::AttributeHelpers::Base;
   3 use Moose;
   4
   5 our $VERSION   = '0.01';
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   8 extends 'Moose::Meta::Attribute';
   9
  10 has 'method_constructors' => (
  11     is      => 'ro',
  12     isa     => 'HashRef',
  13     default => sub { {} }
  14 );
  15
  16 has 'provides' => (
  17     is       => 'ro',
  18     isa      => 'HashRef',
  19     required => 1,
  20 );
  21
  22 has '+$!default'       => (required => 1);
  23 has '+type_constraint' => (required => 1);
  24
  25 sub _check_provides {
  26     my ($self, $provides) = @_;
  27     my $method_constructors = $self->method_constructors;
  28     foreach my $key (keys %$provides) {
  29         (exists $method_constructors->{$key})
  30             || confess "$key is an unsupported method type";
  31     }
  32 }
  33
  34 sub _process_options_for_provides {
  35     my ($self, $options) = @_;
  36     # ...
  37 }
  38
  39 before '_process_options' => sub {
  40     my ($self, %options) = @_;
  41
  42     if (exists $options{provides}) {
  43         $self->_check_provides($options{provides});
  44         $self->_process_options_for_provides(\%options);
  45     }
  46 };
  47
  48 after 'install_accessors' => sub {
  49     my $attr  = shift;
  50     my $class = $attr->associated_class;
  51
  52     my $method_constructors = $attr->method_constructors;
  53
  54     foreach my $key (keys %{$attr->provides}) {
  55         $class->add_method(
  56             $attr->provides->{$key},
  57             $method_constructors->{$key}->($attr)
  58         );
  59     }
  60 };
  61
  62 no Moose;
  63 no Moose::Util::TypeConstraints;
  64
  65
  66 1;
  67
  68 __END__
  69
  70 =pod
  71
  72 =head1 NAME
  73
  74 MooseX::AttributeHelpers::Base
  75
  76 =head1 SYNOPSIS
  77
  78 =head1 DESCRIPTION
  79
  80 =head1 METHODS
  81
  82 =head1 BUGS
  83
  84 All complex software has bugs lurking in it, and this module is no
  85 exception. If you find a bug please either email me, or add the bug
  86 to cpan-RT.
  87
  88 =head1 AUTHOR
  89
  90 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  91
  92 =head1 COPYRIGHT AND LICENSE
  93
  94 Copyright 2007 by Infinity Interactive, Inc.
  95
  96 L<http://www.iinteractive.com>
  97
  98 This library is free software; you can redistribute it and/or modify
  99 it under the same terms as Perl itself.
 100
 101 =cut