local-lib5/lib/perl5/MooseX/MethodAttributes/Role/Meta/Role/Application.pm

   1 package MooseX::MethodAttributes::Role::Meta::Role::Application;
   2 our $VERSION = '0.18';
   3
   4 # ABSTRACT: generic role for applying a role with method attributes to something
   5
   6 use Moose::Role;
   7 use Moose::Util qw/find_meta/;
   8 use MooseX::MethodAttributes ();
   9 use MooseX::MethodAttributes::Role ();
  10 use namespace::clean -except => 'meta';
  11
  12 requires qw/
  13     _copy_attributes
  14     apply
  15 /;
  16
  17
  18 around 'apply' => sub {
  19     my ($orig, $self, $thing, %opts) = @_;
  20     $thing = $self->_apply_metaclasses($thing);
  21
  22     my $ret = $self->$orig($thing, %opts);
  23
  24     $self->_copy_attributes($thing);
  25
  26     return $ret;
  27 };
  28
  29 sub _apply_metaclasses {
  30     my ($self, $thing) = @_;
  31     if ($thing->isa('Moose::Meta::Class')) {
  32         $thing = MooseX::MethodAttributes->init_meta( for_class => $thing->name );
  33     }
  34     elsif ($thing->isa('Moose::Meta::Role')) {
  35         $thing = MooseX::MethodAttributes::Role->init_meta( for_class => $thing->name );
  36     }
  37     else {
  38         croak("Composing " . __PACKAGE__ . " onto instances is unsupported");
  39     }
  40
  41     # Note that the metaclass instance we started out with may have been turned
  42     # into lies by the metatrait role application process, so we explicitly
  43     # re-fetch it here.
  44
  45     # Alternatively, for epic shits and giggles, the meta trait application
  46     # process (onto $thing) may have applied roles to our metaclass, but (if
  47     # $thing is an anon class, not correctly replaced it in the metaclass cache.
  48     # This results in the DESTROY method in Class::MOP::Class r(eap|ape)ing the
  49     # package, which is unfortunate, as it removes all your methods and superclasses.
  50     # Therefore, we avoid that by ramming the metaclass we've just been handed into
  51     # the cache without weakening it.
  52
  53     # I'm fairly sure the 2nd part of that is a Moose bug, and should go away..
  54     # Unfortunately, the implication of that is that whenever you apply roles to a class,
  55     # the metaclass instance can change, and so needs to be re-retrieved or handed back
  56     # to the caller :/
  57     if ($thing->can('is_anon_class') and $thing->is_anon_class) {
  58         Class::MOP::store_metaclass_by_name($thing->name, $thing);
  59     }
  60     else {
  61         return find_meta($thing->name);
  62     }
  63     return $thing;
  64 }
  65
  66 1;
  67
  68 __END__
  69
  70 =pod
  71
  72 =head1 NAME
  73
  74 MooseX::MethodAttributes::Role::Meta::Role::Application - generic role for applying a role with method attributes to something
  75
  76 =head1 VERSION
  77
  78 version 0.18
  79
  80 =head1 METHODS
  81
  82 =head2 apply
  83
  84 The apply method is wrapped to ensure that the correct metaclasses to hold and propagate
  85 method attribute data are present on the target for role application, delegates to
  86 the original method to actually apply the role, then ensures that any attributes from
  87 the role are copied to the target class.
  88
  89
  90
  91 =head1 AUTHORS
  92
  93   Florian Ragwitz <rafl@debian.org>
  94   Tomas Doran <bobtfish@bobtfish.net>
  95
  96 =head1 COPYRIGHT AND LICENSE
  97
  98 This software is copyright (c) 2009 by Florian Ragwitz.
  99
 100 This is free software; you can redistribute it and/or modify it under
 101 the same terms as perl itself.
 102
 103 =cut
 104
 105