lib/Moo/Role.pm

   1 package Moo::Role;
   2
   3 use strictures 1;
   4 use Moo::_Utils;
   5 use base qw(Role::Tiny);
   6
   7 BEGIN { *INFO = \%Role::Tiny::INFO }
   8
   9 our %INFO;
  10
  11 sub import {
  12   my $target = caller;
  13   strictures->import;
  14   return if $INFO{$target}; # already exported into this package
  15   # get symbol table reference
  16   my $stash = do { no strict 'refs'; \%{"${target}::"} };
  17   *{_getglob "${target}::has"} = sub {
  18     my ($name, %spec) = @_;
  19     ($INFO{$target}{accessor_maker} ||= do {
  20       require Method::Generate::Accessor;
  21       Method::Generate::Accessor->new
  22     })->generate_method($target, $name, \%spec);
  23     $INFO{$target}{attributes}{$name} = \%spec;
  24   };
  25   if ($INC{'Moo/HandleMoose.pm'}) {
  26     Moo::HandleMoose::inject_fake_metaclass_for($target);
  27   }
  28   goto &Role::Tiny::import;
  29 }
  30
  31 sub apply_role_to_package {
  32   my ($me, $to, $role) = @_;
  33   $me->SUPER::apply_role_to_package($to, $role);
  34   $me->_handle_constructor($to, $INFO{$role}{attributes});
  35 }
  36
  37 sub create_class_with_roles {
  38   my ($me, $superclass, @roles) = @_;
  39
  40   my $new_name = join(
  41     '__WITH__', $superclass, my $compose_name = join '__AND__', @roles
  42   );
  43
  44   return $new_name if $Role::Tiny::COMPOSED{class}{$new_name};
  45
  46   require Sub::Quote;
  47
  48   $me->SUPER::create_class_with_roles($superclass, @roles);
  49
  50   foreach my $role (@roles) {
  51     die "${role} is not a Role::Tiny" unless my $info = $INFO{$role};
  52   }
  53
  54   $Moo::MAKERS{$new_name} = {};
  55
  56   $me->_handle_constructor(
  57     $new_name, { map %{$INFO{$_}{attributes}||{}}, @roles }, $superclass
  58   );
  59
  60   return $new_name;
  61 }
  62
  63 sub _install_single_modifier {
  64   my ($me, @args) = @_;
  65   _install_modifier(@args);
  66 }
  67
  68 sub _handle_constructor {
  69   my ($me, $to, $attr_info, $superclass) = @_;
  70   return unless $attr_info && keys %$attr_info;
  71   if ($INFO{$to}) {
  72     @{$INFO{$to}{attributes}||={}}{keys %$attr_info} = values %$attr_info;
  73   } else {
  74     # only fiddle with the constructor if the target is a Moo class
  75     if ($INC{"Moo.pm"}
  76         and my $con = Moo->_constructor_maker_for($to, $superclass)) {
  77       $con->register_attribute_specs(%$attr_info);
  78     }
  79   }
  80 }
  81
  82 1;
  83
  84 =head1 NAME
  85
  86 Moo::Role - Minimal Object Orientation support for Roles
  87
  88 =head1 SYNOPSIS
  89
  90  package My::Role;
  91
  92  use Moo::Role;
  93
  94  sub foo { ... }
  95
  96  sub bar { ... }
  97
  98  has baz => (
  99    is => 'ro',
 100  );
 101
 102  1;
 103
 104 else where
 105
 106  package Some::Class;
 107
 108  use Moo;
 109
 110  # bar gets imported, but not foo
 111  with('My::Role');
 112
 113  sub foo { ... }
 114
 115  1;
 116
 117 =head1 DESCRIPTION
 118
 119 C<Moo::Role> builds upon L<Role::Tiny>, so look there for most of the
 120 documentation on how this works.  The main addition here is extra bits to make
 121 the roles more "Moosey;" which is to say, it adds L</has>.
 122
 123 =head1 IMPORTED SUBROUTINES
 124
 125 See L<Role::Tiny/IMPORTED SUBROUTINES> for all the other subroutines that are
 126 imported by this module.
 127
 128 =head2 has
 129
 130  has attr => (
 131    is => 'ro',
 132  );
 133
 134 Declares an attribute for the class to be composed into.  See
 135 L<Moo/has> for all options.
 136
 137 =head1 AUTHORS
 138
 139 See L<Moo> for authors.
 140
 141 =head1 COPYRIGHT AND LICENSE
 142
 143 See L<Moo> for the copyright and license.
 144
 145 =cut