X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Flib%2FMooseCompat.pm;h=8bb95cfd7708ca7d8dbb5960ae809322a4375efe;hb=65a61aeecb1a9cc9d3f1f07a35a1f084b0b683ab;hp=19ae7cb25215c6ba443fbd900f4caf481b6e3669;hpb=677ad8d01df4961c767a6f85c57d1c6e72933924;p=gitmo%2FMouse.git diff --git a/t/lib/MooseCompat.pm b/t/lib/MooseCompat.pm index 19ae7cb..8bb95cf 100644 --- a/t/lib/MooseCompat.pm +++ b/t/lib/MooseCompat.pm @@ -1,5 +1,33 @@ package MooseCompat; # Moose compatible methods/functions +use Mouse (); +use Mouse::Util::MetaRole; +use Mouse::Meta::Method; +use Mouse::Meta::Role::Method; + +$INC{'Mouse/Meta.pm'} = __FILE__; +$INC{'Mouse/Meta/Instance.pm'} = __FILE__; +$INC{'Mouse/Deprecated.pm'} = __FILE__; + + +*UNIVERSAL::DOES = sub { + my($thing, $role) = @_; + $thing->isa($role); +} unless UNIVERSAL->can('DOES'); + +$Mouse::Deprecated::deprecated = $Mouse::Deprecated::deprecated = undef; # -w + +package Mouse::Util; + +sub resolve_metatrait_alias { + return resolve_metaclass_alias( @_, trait => 1); +} + +sub ensure_all_roles { + my $consumer = shift; + apply_all_roles($consumer, grep { !does_role($appicant, $_) } @_); + return; +} package Mouse::Meta::Module; @@ -14,6 +42,8 @@ sub identifier { ); } +sub role_applications { } + package Mouse::Meta::Role; for my $modifier_type (qw/before after around/) { @@ -40,6 +70,12 @@ sub get_method_modifier_list { return keys %{ $self->{$modifier_type . '_method_modifiers'} }; } +package Mouse::Meta::Method; + +sub get_original_method { Mouse::Meta::Method->wrap(sub { }) } + +sub associated_attribute { undef } + package Mouse::Util::TypeConstraints; use Mouse::Util::TypeConstraints (); @@ -57,10 +93,33 @@ sub export_type_constraints_as_functions { # TEST ONLY return; } -package - Mouse::Meta::Attribute; +package Mouse::Meta::Attribute; sub applied_traits{ $_[0]->{traits} } # TEST ONLY sub has_applied_traits{ exists $_[0]->{traits} } # TEST ONLY +sub get_raw_value { undef } # not supported +sub set_raw_value { undef } # not supported + +package Mouse::Meta::TypeConstraint; + +sub has_message { exists $_[0]->{message} } + +sub validate { + my($self, $value) = @_; + return $self->check($value) ? undef : $self->get_message($value); +} + +sub is_subtype_of { + my($self, $other) = @_; + return undef; # not supported +} + +sub equals { + my($self, $other) = @_; + return undef; # not supported +} + +sub class { undef } +sub role { undef } 1;