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