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   goto &Role::Tiny::import;
  26 }
  27
  28 sub apply_role_to_package {
  29   my ($me, $to, $role) = @_;
  30   $me->SUPER::apply_role_to_package($to, $role);
  31   $me->_handle_constructor($to, $INFO{$role}{attributes});
  32 }
  33
  34 sub create_class_with_roles {
  35   my ($me, $superclass, @roles) = @_;
  36
  37   my $new_name = join('+', $superclass, my $compose_name = join '+', @roles);
  38   return $new_name if $Role::Tiny::COMPOSED{class}{$new_name};
  39
  40   require Sub::Quote;
  41
  42   $me->SUPER::create_class_with_roles($superclass, @roles);
  43
  44   foreach my $role (@roles) {
  45     die "${role} is not a Role::Tiny" unless my $info = $INFO{$role};
  46   }
  47
  48   $me->_handle_constructor(
  49     $new_name, { map %{$INFO{$_}{attributes}||{}}, @roles }, $superclass
  50   );
  51
  52   return $new_name;
  53 }
  54
  55 sub _install_single_modifier {
  56   my ($me, @args) = @_;
  57   _install_modifier(@args);
  58 }
  59
  60 sub _handle_constructor {
  61   my ($me, $to, $attr_info, $superclass) = @_;
  62   return unless $attr_info && keys %$attr_info;
  63   if ($INFO{$to}) {
  64     @{$INFO{$to}{attributes}||={}}{keys %$attr_info} = values %$attr_info;
  65   } else {
  66     # only fiddle with the constructor if the target is a Moo class
  67     if ($INC{"Moo.pm"}
  68         and my $con = Moo->_constructor_maker_for($to, $superclass)) {
  69       $con->register_attribute_specs(%$attr_info);
  70     }
  71   }
  72 }
  73
  74 1;
  75
  76 =head1 NAME
  77
  78 Moo::Role - Minimal Object Orientation support for Roles
  79
  80 =head1 SYNOPSIS
  81
  82  package My::Role;
  83
  84  use Moo::Role;
  85
  86  sub foo { ... }
  87
  88  sub bar { ... }
  89
  90  has baz => (
  91    is => 'ro',
  92  );
  93
  94  1;
  95
  96 else where
  97
  98  package Some::Class;
  99
 100  use Moo;
 101
 102  # bar gets imported, but not foo
 103  with('My::Role');
 104
 105  sub foo { ... }
 106
 107  1;
 108
 109 =head1 DESCRIPTION
 110
 111 C<Moo::Role> builds upon L<Role::Tiny>, so look there for most of the
 112 documentation on how this works.  The main addition here is extra bits to make
 113 the roles more "Moosey;" which is to say, it adds L</has>.
 114
 115 =head1 IMPORTED SUBROUTINES
 116
 117 See L<Role::Tiny/IMPORTED SUBROUTINES> for all the other subroutines that are
 118 imported by this module.
 119
 120 =head2 has
 121
 122  has attr => (
 123    is => 'ro',
 124  );
 125
 126 Declares an attribute for the class to be composed into.  See
 127 L<Moo/has> for all options.