From: Dave Rolsky Date: Wed, 16 Dec 2009 16:17:12 +0000 (-0600) Subject: Make Class::MOP::MiniTrait, which for now just encapsulates the logic that is used... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a10cbf93be10c10392ee802bd3da6f7803b74fb7;p=gitmo%2FClass-MOP.git Make Class::MOP::MiniTrait, which for now just encapsulates the logic that is used to apply immutability to a metaclass. This will expand as I move more functionality into mini traits. --- diff --git a/lib/Class/MOP/MiniTrait.pm b/lib/Class/MOP/MiniTrait.pm new file mode 100644 index 0000000..c21d151 --- /dev/null +++ b/lib/Class/MOP/MiniTrait.pm @@ -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;