X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=796872acb393f956b5c2a90cff9d7c57a1ba66d3;hb=50dc6ee5748409751a8e0ef57a0e7c93e2c48cb4;hp=96da88f49e0590f6eb19302afc326367b6569fff;hpb=1a0f0802dbe504e1b31f9227a86f32ccda74de61;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 96da88f..796872a 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -7,6 +7,7 @@ use Scalar::Util 'blessed'; use Carp 'confess'; use MRO::Compat; +use Class::Method::Modifiers (); do { my %METACLASS_CACHE; @@ -54,6 +55,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; @@ -98,7 +110,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 +126,40 @@ 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) = @_; + Class::Method::Modifiers::_install_modifier( + $self->name, + 'before', + $name, + $code, + ); +} + +sub add_around_method_modifier { + my ($self, $name, $code) = @_; + Class::Method::Modifiers::_install_modifier( + $self->name, + 'around', + $name, + $code, + ); +} + +sub add_after_method_modifier { + my ($self, $name, $code) = @_; + Class::Method::Modifiers::_install_modifier( + $self->name, + 'after', + $name, + $code, + ); +} 1;