lib/Class/MOP/MiniTrait.pm

   1 package Class::MOP::MiniTrait;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Class::Load qw(load_class);
   7
   8 sub apply {
   9     my ( $to_class, $trait ) = @_;
  10
  11     for ( grep { !ref } $to_class, $trait ) {
  12         load_class($_);
  13         $_ = Class::MOP::Class->initialize($_);
  14     }
  15
  16     for my $meth ( $trait->get_all_methods ) {
  17         my $meth_name = $meth->name;
  18
  19         if ( $to_class->find_method_by_name($meth_name) ) {
  20             $to_class->add_around_method_modifier( $meth_name, $meth->body );
  21         }
  22         else {
  23             $to_class->add_method( $meth_name, $meth->clone );
  24         }
  25     }
  26 }
  27
  28 # We can't load this with use, since it may be loaded and used from Class::MOP
  29 # (via CMOP::Class, etc). However, if for some reason this module is loaded
  30 # _without_ first loading Class::MOP we need to require Class::MOP so we can
  31 # use it and CMOP::Class.
  32 require Class::MOP;
  33
  34 1;
  35
  36 __END__
  37
  38 =pod
  39
  40 =head1 NAME
  41
  42 Class::MOP::MiniTrait - Extremely limited trait application
  43
  44 =head1 DESCRIPTION
  45
  46 This package provides a single function, C<apply>, which does a half-assed job
  47 of applying a trait to a class. It exists solely for use inside Class::MOP and
  48 L<Moose> core classes.
  49
  50 =cut
  51