lib/Moose/Meta/Role/Application/ToInstance.pm

   1 package Moose::Meta::Role::Application::ToInstance;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 use Scalar::Util 'blessed';
   8 use List::MoreUtils 'all';
   9
  10 use base 'Moose::Meta::Role::Application';
  11
  12 __PACKAGE__->meta->add_attribute('rebless_params' => (
  13     reader  => 'rebless_params',
  14     default => sub { {} }
  15 ));
  16
  17 sub apply {
  18     my ( $self, $role, $object, $args ) = @_;
  19
  20     my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class';
  21
  22     # This is a special case to handle the case where the object's metaclass
  23     # is a Class::MOP::Class, but _not_ a Moose::Meta::Class (for example,
  24     # when applying a role to a Moose::Meta::Attribute object).
  25     $obj_meta = 'Moose::Meta::Class'
  26         unless $obj_meta->isa('Moose::Meta::Class');
  27
  28     my $class = $obj_meta->create_anon_class(
  29         superclasses => [ blessed($object) ],
  30         roles => [ $role, keys(%$args) ? ($args) : () ],
  31         cache => (all { $_ eq '-alias' || $_ eq '-excludes' } keys %$args),
  32     );
  33
  34     $class->rebless_instance( $object, %{ $self->rebless_params } );
  35 }
  36
  37 1;
  38
  39 # ABSTRACT: Compose a role into an instance
  40
  41 __END__
  42
  43 =pod
  44
  45 =head1 DESCRIPTION
  46
  47 =head2 METHODS
  48
  49 =over 4
  50
  51 =item B<new>
  52
  53 =item B<meta>
  54
  55 =item B<apply>
  56
  57 =item B<rebless_params>
  58
  59 =back
  60
  61 =head1 BUGS
  62
  63 See L<Moose/BUGS> for details on reporting bugs.
  64
  65 =cut
  66