lib/Reaction/Role.pm

   1 package Reaction::Role;
   2
   3 use Moose::Role ();
   4 use Reaction::ClassExporter;
   5 use Reaction::Class;
   6 use Moose::Meta::Class;
   7
   8 #TODO: review for Reaction::Object switch / Reaction::Meta::Class
   9
  10 use namespace::clean -except => [ qw(meta) ];
  11
  12 override exports_for_package => sub {
  13   my ($self, $package) = @_;
  14   my %exports = $self->SUPER::exports_for_package($package);
  15   delete $exports{class};
  16   $exports{role} = sub { $self->do_role_sub($package, @_); };
  17   return %exports;
  18 };
  19
  20 override next_import_package => sub { 'Moose::Role' };
  21
  22 override default_base => sub { () };
  23
  24 override add_method_to_target => sub {
  25   my ($self, $target, $method) = @_;
  26   $target->meta->add_method(@$method);
  27 };
  28 override next_import => sub {
  29   my ($self) = @_;
  30   my $import = super;
  31   # ugh
  32   return sub {
  33       push @_, '-metaclass' => 'Reaction::Meta::Role';
  34       goto $import;
  35   };
  36 };
  37 sub do_role_sub {
  38   my ($self, $package, $role, $which, $setup) = @_;
  39   confess "Invalid role declaration, should be: role Role which { ... }"
  40     unless ($which eq 'which' && ref($setup) eq 'CODE');
  41   $self->setup_and_cleanup($role, $setup);
  42 };
  43
  44 __PACKAGE__->meta->make_immutable;
  45
  46
  47 1;
  48
  49 =head1 NAME
  50
  51 Reaction::Role
  52
  53 =head1 DESCRIPTION
  54
  55 =head1 SEE ALSO
  56
  57 L<Moose::Role>
  58
  59 =head1 AUTHORS
  60
  61 See L<Reaction::Class> for authors.
  62
  63 =head1 LICENSE
  64
  65 See L<Reaction::Class> for the license.
  66
  67 =cut