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