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

   1 package Moose::Meta::Role::Application::ToMetaclassInstance;
   2
   3 use strict;
   4 use warnings;
   5 use metaclass;
   6
   7 use Scalar::Util 'blessed';
   8
   9 our $VERSION   = '0.55';
  10 our $AUTHORITY = 'cpan:STEVAN';
  11
  12 use base 'Moose::Meta::Role::Application::ToClass';
  13
  14 __PACKAGE__->meta->add_attribute('rebless_params' => (
  15     reader  => 'rebless_params',
  16     default => sub { {} }
  17 ));
  18
  19 my %ANON_CLASSES;
  20
  21 sub apply {
  22     my ( $self, $role, $meta ) = @_;
  23
  24     my $anon_role_key = (blessed($meta) . $role->name);
  25
  26     my $class;
  27     if (exists $ANON_CLASSES{$anon_role_key} && defined $ANON_CLASSES{$anon_role_key}) {
  28         $class = $ANON_CLASSES{$anon_role_key};
  29     }
  30     else {
  31         my $metaclass_class
  32             = ( ref $meta )->can('create_anon_class')
  33             ? ref $meta
  34             : 'Moose::Meta::Class';
  35         $class = $metaclass_class->create_anon_class(
  36             superclasses => [ blessed($meta) ],
  37         );
  38
  39         $ANON_CLASSES{$anon_role_key} = $class;
  40         $self->SUPER::apply( $role, $class );
  41     }
  42
  43     $class->rebless_instance( $meta, %{ $self->rebless_params } );
  44 }
  45
  46 1;
  47
  48 __END__
  49
  50 =pod
  51
  52 =head1 NAME
  53
  54 Moose::Meta::Role::Application::ToMetaclassInstance - Compose a role into a metaclass instance
  55
  56 =head1 DESCRIPTION
  57
  58 =head2 METHODS
  59
  60 =over 4
  61
  62 =item B<new>
  63
  64 =item B<meta>
  65
  66 =item B<apply>
  67
  68 =item B<rebless_params>
  69
  70 =back
  71
  72 =head1 BUGS
  73
  74 All complex software has bugs lurking in it, and this module is no
  75 exception. If you find a bug please either email me, or add the bug
  76 to cpan-RT.
  77
  78 =head1 AUTHOR
  79
  80 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  81
  82 =head1 COPYRIGHT AND LICENSE
  83
  84 Copyright 2006-2008 by Infinity Interactive, Inc.
  85
  86 L<http://www.iinteractive.com>
  87
  88 This library is free software; you can redistribute it and/or modify
  89 it under the same terms as Perl itself.
  90
  91 =cut
  92