X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=31e4a12b947664f6e7bfa87b7df3981e81490252;hp=2aa712ecf2e312e0b15b3290867ef43275ee43cb;hb=cb60d0b55962e6ff8cdc07e51e59f7dd5feafd43;hpb=d503a4f3aa9eda772309f6c99ccd4dfcdfed059d diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index 2aa712e..31e4a12 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -11,6 +11,19 @@ use warnings FATAL => 'redefine'; # to avoid to load Mouse::PurePerl use B (); + +# taken from Class/MOP.pm +sub is_valid_class_name { + my $class = shift; + + return 0 if ref($class); + return 0 unless defined($class); + + return 1 if $class =~ /\A \w+ (?: :: \w+ )* \z/xms; + + return 0; +} + sub is_class_loaded { my $class = shift; @@ -193,9 +206,7 @@ sub _parameterize_Maybe_for { return sub{ return !defined($_) || $check->($_); }; -}; - - +} package Mouse::Meta::Module; @@ -333,6 +344,38 @@ sub is_anon_role{ sub get_roles { $_[0]->{roles} } +sub add_before_method_modifier { + my ($self, $method_name, $method) = @_; + + push @{ $self->{before_method_modifiers}{$method_name} ||= [] }, $method; + return; +} +sub add_around_method_modifier { + my ($self, $method_name, $method) = @_; + + push @{ $self->{around_method_modifiers}{$method_name} ||= [] }, $method; + return; +} +sub add_after_method_modifier { + my ($self, $method_name, $method) = @_; + + push @{ $self->{after_method_modifiers}{$method_name} ||= [] }, $method; + return; +} + +sub get_before_method_modifiers { + my ($self, $method_name) = @_; + return @{ $self->{before_method_modifiers}{$method_name} ||= [] } +} +sub get_around_method_modifiers { + my ($self, $method_name) = @_; + return @{ $self->{around_method_modifiers}{$method_name} ||= [] } +} +sub get_after_method_modifiers { + my ($self, $method_name) = @_; + return @{ $self->{after_method_modifiers}{$method_name} ||= [] } +} + package Mouse::Meta::Attribute; require Mouse::Meta::Method::Accessor; @@ -517,14 +560,12 @@ sub name { $_[0]->{name} } sub parent { $_[0]->{parent} } sub message { $_[0]->{message} } -sub type_parameter { $_[0]->{type_parameter} } -sub __is_parameterized { exists $_[0]->{type_parameter} } - +sub type_parameter { $_[0]->{type_parameter} } sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} } - sub _compiled_type_coercion { $_[0]->{_compiled_type_coercion} } -sub has_coercion{ exists $_[0]->{_compiled_type_coercion} } +sub __is_parameterized { exists $_[0]->{type_parameter} } +sub has_coercion { exists $_[0]->{_compiled_type_coercion} } sub compile_type_constraint{ @@ -575,7 +616,6 @@ sub compile_type_constraint{ package Mouse::Object; - sub BUILDARGS { my $class = shift; @@ -623,7 +663,6 @@ sub DESTROY { my $e = do{ local $@; eval{ - # DEMOLISHALL # We cannot count on being able to retrieve a previously made @@ -672,7 +711,7 @@ Mouse::PurePerl - A Mouse guts in pure Perl =head1 VERSION -This document describes Mouse version 0.50_02 +This document describes Mouse version 0.50_03 =head1 SEE ALSO