X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=ede54ca89ab73cc200657d277119f376cec25e2c;hb=3e44140bf0332cf0e44055fd76c2ba43cd898161;hp=f2802dbb5f057854fd5b6edbb9f4d92d50117db1;hpb=1d5ecd5f15a0f418bee471c00af2357ba63b99ba;p=gitmo%2FMouse.git diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index f2802db..ede54ca 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -77,10 +77,12 @@ sub get_code_ref{ package Mouse::Util::TypeConstraints; +use Scalar::Util qw(blessed looks_like_number openhandle); + sub _generate_class_type_for{ my($for_class, $name) = @_; - my $predicate = sub{ Scalar::Util::blessd($_[0]) && $_[0]->isa($for_class) }; + my $predicate = sub{ blessed($_[0]) && $_[0]->isa($for_class) }; if(defined $name){ no strict 'refs'; @@ -132,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; @@ -155,6 +181,7 @@ sub get_roles { $_[0]->{roles} } package Mouse::Meta::Attribute; +use Mouse::Meta::Method::Accessor; # readers