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