lib/Class/MOP/MiniTrait.pm

   1 package Class::MOP::MiniTrait;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '1.12';
   7 $VERSION = eval $VERSION;
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 sub apply {
  11     my ( $to_class, $trait ) = @_;
  12
  13     for ( grep { !ref } $to_class, $trait ) {
  14         Class::MOP::load_class($_);
  15         $_ = Class::MOP::Class->initialize($_);
  16     }
  17
  18     for my $meth ( $trait->get_all_methods ) {
  19         my $meth_name = $meth->name;
  20
  21         if ( $to_class->find_method_by_name($meth_name) ) {
  22             $to_class->add_around_method_modifier( $meth_name, $meth->body );
  23         }
  24         else {
  25             $to_class->add_method( $meth_name, $meth->clone );
  26         }
  27     }
  28 }
  29
  30 # We can't load this with use, since it may be loaded and used from Class::MOP
  31 # (via CMOP::Class, etc). However, if for some reason this module is loaded
  32 # _without_ first loading Class::MOP we need to require Class::MOP so we can
  33 # use it and CMOP::Class.
  34 require Class::MOP;
  35
  36 1;
  37
  38 __END__
  39
  40 =pod
  41
  42 =head1 NAME
  43
  44 Class::MOP::MiniTrait - Extremely limited trait application
  45
  46 =head1 DESCRIPTION
  47
  48 This package provides a single function, C<apply>, which does a half-assed job
  49 of applying a trait to a class. It exists solely for use inside Class::MOP and
  50 L<Moose> core classes.
  51
  52 =head1 AUTHORS
  53
  54 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  55
  56 =head1 COPYRIGHT AND LICENSE
  57
  58 Copyright 2006-2010 by Infinity Interactive, Inc.
  59
  60 L<http://www.iinteractive.com>
  61
  62 This library is free software; you can redistribute it and/or modify
  63 it under the same terms as Perl itself.
  64
  65 =cut
  66