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 use Data::Dumper;
  11
  12 our $VERSION   = '0.01';
  13 our $AUTHORITY = 'cpan:STEVAN';
  14
  15 use base 'Moose::Meta::Role::Application::ToClass';
  16
  17 my $anon_counter = 0;
  18
  19 sub apply {
  20     my ($self, $role, $object) = @_;
  21
  22     # FIXME:
  23     # We really should do this better, and
  24     # cache the results of our efforts so
  25     # that we don't need to repeat them.
  26
  27     my $pkg_name = __PACKAGE__ . "::__RUNTIME_ROLE_ANON_CLASS__::" . $anon_counter++;
  28     eval "package " . $pkg_name . "; our \$VERSION = '0.00';";
  29     die $@ if $@;
  30
  31     my $class = Moose::Meta::Class->initialize($pkg_name);
  32     $class->superclasses(blessed($object));
  33
  34     bless $object => $class->name;
  35
  36     $self->SUPER::apply($role, $class);
  37 }
  38
  39 1;
  40
  41 __END__
  42
  43 =pod
  44
  45 =head1 NAME
  46
  47 Moose::Meta::Role::Application::ToInstance
  48
  49 =head1 DESCRIPTION
  50
  51 =head2 METHODS
  52
  53 =over 4
  54
  55 =item B<new>
  56
  57 =item B<meta>
  58
  59 =item B<apply>
  60
  61 =back
  62
  63 =head1 BUGS
  64
  65 All complex software has bugs lurking in it, and this module is no
  66 exception. If you find a bug please either email me, or add the bug
  67 to cpan-RT.
  68
  69 =head1 AUTHOR
  70
  71 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  72
  73 =head1 COPYRIGHT AND LICENSE
  74
  75 Copyright 2006-2008 by Infinity Interactive, Inc.
  76
  77 L<http://www.iinteractive.com>
  78
  79 This library is free software; you can redistribute it and/or modify
  80 it under the same terms as Perl itself.
  81
  82 =cut
  83