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