X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=661aad06ff3754fd584bd8576df4c47a63de494e;hb=4e31595cef06f35cd442a54206f3c1a05c1ac31f;hp=96da88f49e0590f6eb19302afc326367b6569fff;hpb=1a0f0802dbe504e1b31f9227a86f32ccda74de61;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 96da88f..661aad0 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -3,11 +3,9 @@ package Mouse::Meta::Class; use strict; use warnings; -use Scalar::Util 'blessed'; +use Mouse::Util qw/get_linear_isa blessed/; use Carp 'confess'; -use MRO::Compat; - do { my %METACLASS_CACHE; @@ -54,6 +52,17 @@ sub superclasses { @{ $self->{superclasses} }; } +sub add_method { + my $self = shift; + my $name = shift; + my $code = shift; + + my $pkg = $self->name; + + no strict 'refs'; + *{ $pkg . '::' . $name } = $code; +} + sub add_attribute { my $self = shift; my $attr = shift; @@ -82,7 +91,7 @@ sub get_attribute_map { $_[0]->{attributes} } sub has_attribute { exists $_[0]->{attributes}->{$_[1]} } sub get_attribute { $_[0]->{attributes}->{$_[1]} } -sub linearized_isa { @{ mro::get_linear_isa($_[0]->name) } } +sub linearized_isa { @{ get_linear_isa($_[0]->name) } } sub clone_object { my $class = shift; @@ -98,7 +107,7 @@ sub clone_instance { my ($class, $instance, %params) = @_; (blessed($instance)) - || confess "You can only clone instances, \$self is not a blessed instance"; + || confess "You can only clone instances, ($instance) is not a blessed instance"; my $clone = bless { %$instance }, ref $instance; @@ -114,6 +123,43 @@ sub clone_instance { } +sub make_immutable {} +sub is_immutable { 0 } + +sub attribute_metaclass { "Mouse::Meta::Class" } + +sub add_before_method_modifier { + my ($self, $name, $code) = @_; + require Class::Method::Modifiers; + Class::Method::Modifiers::_install_modifier( + $self->name, + 'before', + $name, + $code, + ); +} + +sub add_around_method_modifier { + my ($self, $name, $code) = @_; + require Class::Method::Modifiers; + Class::Method::Modifiers::_install_modifier( + $self->name, + 'around', + $name, + $code, + ); +} + +sub add_after_method_modifier { + my ($self, $name, $code) = @_; + require Class::Method::Modifiers; + Class::Method::Modifiers::_install_modifier( + $self->name, + 'after', + $name, + $code, + ); +} 1;