X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=885788ae75ac1595eb03d18f55dcd68c580b056d;hb=d44f0d03f175f6812650ec7c86cb3b3878667cae;hp=09f5077e692ccd3de92f16ade934684362169765;hpb=a5fc1e9ae701943f0fd4bd9ba81a9a6eab523d0b;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index 09f5077..885788a 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -1,47 +1,32 @@ package Mouse::Util::TypeConstraints; use strict; use warnings; +use base 'Exporter'; use Carp (); use Scalar::Util qw/blessed looks_like_number openhandle/; +our @EXPORT = qw( + as where message from via type subtype coerce class_type role_type enum +); + my %TYPE; my %TYPE_SOURCE; my %COERCE; my %COERCE_KEYS; -#find_type_constraint register_type_constraint -sub import { - my $class = shift; - my %args = @_; - my $caller = $args{callee} || caller(0); - - no strict 'refs'; - *{"$caller\::as"} = \&_as; - *{"$caller\::where"} = \&_where; - *{"$caller\::message"} = \&_message; - *{"$caller\::from"} = \&_from; - *{"$caller\::via"} = \&_via; - *{"$caller\::type"} = \&_type; - *{"$caller\::subtype"} = \&_subtype; - *{"$caller\::coerce"} = \&_coerce; - *{"$caller\::class_type"} = \&_class_type; - *{"$caller\::role_type"} = \&_role_type; -} - - -sub _as ($) { +sub as ($) { as => $_[0] } -sub _where (&) { +sub where (&) { where => $_[0] } -sub _message ($) { +sub message (&) { message => $_[0] } -sub _from { @_ } -sub _via (&) { +sub from { @_ } +sub via (&) { $_[0] } @@ -87,7 +72,7 @@ my $optimized_constraints_base; @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS; } -sub _type { +sub type { my $pkg = caller(0); my($name, %conf) = @_; if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) { @@ -99,7 +84,7 @@ sub _type { $TYPE{$name} = $constraint; } -sub _subtype { +sub subtype { my $pkg = caller(0); my($name, %conf) = @_; if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) { @@ -117,7 +102,7 @@ sub _subtype { } } -sub _coerce { +sub coerce { my($name, %conf) = @_; Carp::croak "Cannot find type '$name', perhaps you forgot to load it." @@ -139,19 +124,19 @@ sub _coerce { } } -sub _class_type { +sub class_type { my $pkg = caller(0); my($name, $conf) = @_; my $class = $conf->{class}; - _subtype( + subtype( $name => where => sub { $_->isa($class) } ); } -sub _role_type { +sub role_type { my($name, $conf) = @_; my $role = $conf->{role}; - _subtype( + subtype( $name => where => sub { return unless defined $_ && ref($_) && $_->isa('Mouse::Object'); $_->meta->does_role($role); @@ -176,6 +161,15 @@ sub typecast_constraints { return $value; } +sub enum { + my $name = shift; + my %is_valid = map { $_ => 1 } @_; + + subtype( + $name => where => sub { $is_valid{$_} } + ); +} + 1; __END__