Make Class::MOP::MiniTrait, which for now just encapsulates the logic that is used...
Dave Rolsky [Wed, 16 Dec 2009 16:17:12 +0000 (10:17 -0600)]
This will expand as I move more functionality into mini traits.

lib/Class/MOP/MiniTrait.pm [new file with mode: 0644]

diff --git a/lib/Class/MOP/MiniTrait.pm b/lib/Class/MOP/MiniTrait.pm
new file mode 100644 (file)
index 0000000..c21d151
--- /dev/null
@@ -0,0 +1,33 @@
+package Class::MOP::MiniTrait;
+
+use strict;
+use warnings;
+
+use Scalar::Util 'blessed';
+
+our $VERSION   = '0.95';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Class::MOP::Object';
+
+sub apply {
+    my $class = shift;
+    my $meta  = shift;
+
+    die "The Class::MOP::MiniTrait->apply() method expects a metaclass object"
+        unless $meta && blessed $meta && $meta->isa('Class::MOP::Class');
+
+    for my $meth_name ( $class->meta->get_method_list ) {
+        my $meth = $class->meta->get_method($meth_name);
+
+        if ( $meta->find_method_by_name($meth_name) ) {
+            $meta->add_around_method_modifier( $meth_name, $meth->body );
+        }
+        else {
+            $meta->add_method( $meth_name, $meth->clone );
+        }
+    }
+}
+
+1;