X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=ede54ca89ab73cc200657d277119f376cec25e2c;hp=b60721e33668d73c82a3883a7a61dd64002c2ae8;hb=3e44140bf0332cf0e44055fd76c2ba43cd898161;hpb=34bdc46af065df1aa23fefd987f02e7e1856e87e diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index b60721e..ede54ca 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -134,6 +134,30 @@ sub namespace{ return \%{ $name . '::' }; } +sub add_method { + my($self, $name, $code) = @_; + + if(!defined $name){ + $self->throw_error('You must pass a defined name'); + } + if(!defined $code){ + $self->throw_error('You must pass a defined code'); + } + + if(ref($code) ne 'CODE'){ + $code = \&{$code}; # coerce + } + + $self->{methods}->{$name} = $code; # Moose stores meta object here. + + my $pkg = $self->name; + no strict 'refs'; + no warnings 'redefine', 'once'; + *{ $pkg . '::' . $name } = $code; + return; +} + + package Mouse::Meta::Class;