From: gfx Date: Tue, 27 Oct 2009 01:40:21 +0000 (+0900) Subject: More compatibility to Moose X-Git-Tag: 0.40_02~27 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=337e3b0cb7242e70393f0aa9de379538aed1bf8a;p=gitmo%2FMouse.git More compatibility to Moose --- diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index b0db34b..68a9122 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -159,30 +159,20 @@ sub coerce { } sub class_type { - my($name, $conf) = @_; - if ($conf && $conf->{class}) { - # No, you're using this wrong - warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?"; - _create_type 'subtype', $name => ( - as => $conf->{class}, - - type => 'Class', - ); - } - else { - _create_type 'subtype', $name => ( - as => 'Object', - optimized_as => _generate_class_type_for($name), + my($name, $options) = @_; + my $class = $options->{class} || $name; + return _create_type 'subtype', $name => ( + as => 'Object', + optimized_as => _generate_class_type_for($class), - type => 'Class', - ); - } + type => 'Class', + ); } sub role_type { - my($name, $conf) = @_; - my $role = ($conf && $conf->{role}) ? $conf->{role} : $name; - _create_type 'subtype', $name => ( + my($name, $options) = @_; + my $role = $options->{role} || $name; + return _create_type 'subtype', $name => ( as => 'Object', optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) }, @@ -224,11 +214,8 @@ sub _find_or_create_regular_type{ return $TYPE{$spec} if exists $TYPE{$spec}; - my $meta = Mouse::Util::get_metaclass_by_name($spec); - - if(!$meta){ - return; - } + my $meta = Mouse::Util::get_metaclass_by_name($spec) + or return undef; if(_is_a_metarole($meta)){ return role_type($spec);