From: Dave Rolsky <autarch@urth.org>
Date: Thu, 23 Sep 2010 17:14:43 +0000 (-0500)
Subject: Add CMOP::MiniTrait
X-Git-Tag: 1.09~37
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=35cb21ab779b93ddaeda0bba5fb8794d98fbb33a;p=gitmo%2FClass-MOP.git

Add CMOP::MiniTrait

This just takes the logic that we use when applying the immutability trait and
puts it into a separate package for reuse by other core classes.
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 5743fa2..af9b9fe 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -8,6 +8,7 @@ use Class::MOP::Instance;
 use Class::MOP::Method::Wrapped;
 use Class::MOP::Method::Accessor;
 use Class::MOP::Method::Constructor;
+use Class::MOP::MiniTrait;
 
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
@@ -1177,17 +1178,7 @@ sub _immutable_metaclass {
         superclasses => [ ref $self ],
     );
 
-    Class::MOP::load_class($trait);
-    for my $meth ( Class::MOP::Class->initialize($trait)->get_all_methods ) {
-        my $meth_name = $meth->name;
-
-        if ( $immutable_meta->find_method_by_name( $meth_name ) ) {
-            $immutable_meta->add_around_method_modifier( $meth_name, $meth->body );
-        }
-        else {
-            $immutable_meta->add_method( $meth_name, $meth->clone );
-        }
-    }
+    Class::MOP::MiniTrait::apply( $immutable_meta, $trait );
 
     $immutable_meta->make_immutable(
         inline_constructor => 0,
diff --git a/lib/Class/MOP/MiniTrait.pm b/lib/Class/MOP/MiniTrait.pm
new file mode 100644
index 0000000..b57c6d8
--- /dev/null
+++ b/lib/Class/MOP/MiniTrait.pm
@@ -0,0 +1,60 @@
+package Class::MOP::MiniTrait;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.08';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+sub apply {
+    my ( $to_class, $trait ) = @_;
+
+    for ( grep { !ref } $to_class, $trait ) {
+        Class::MOP::load_class($_);
+        $_ = Class::MOP::Class->initialize($_);
+    }
+
+    for my $meth ( $trait->get_all_methods ) {
+        my $meth_name = $meth->name;
+
+        if ( $to_class->find_method_by_name($meth_name) ) {
+            $to_class->add_around_method_modifier( $meth_name, $meth->body );
+        }
+        else {
+            $to_class->add_method( $meth_name, $meth->clone );
+        }
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME 
+
+Class::MOP::MiniTrait - Extremely limited trait application
+
+=head1 DESCRIPTION
+
+This package provides a single function, C<apply>, which does a half-assed job
+of applying a trait to a class. It exists solely for use inside Class::MOP and
+L<Moose> core classes.
+
+=head1 AUTHORS
+
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2010 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
diff --git a/xt/author/pod_coverage.t b/xt/author/pod_coverage.t
index c4edf97..be543c4 100644
--- a/xt/author/pod_coverage.t
+++ b/xt/author/pod_coverage.t
@@ -95,6 +95,7 @@ my %trustme = (
             initialize_body
             )
     ],
+    'Class::MOP::MiniTrait' => ['.+'],
     'Class::MOP::Mixin::AttributeCore' => ['.+'],
     'Class::MOP::Mixin::HasAttributes' => ['.+'],
     'Class::MOP::Mixin::HasMethods'    => ['.+'],