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