X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=e811ad5833efca840823c01a1e30ff46d5fce8c7;hb=5fa003bf0b3308fd48519ff1173feb778c550c01;hp=732797fb87d2a2111e88b00310ee5fe0b9fce204;hpb=7dbebb1bd235797a97c433d40c50a70628a07e3f;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 732797f..e811ad5 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,10 +72,10 @@ my $optimized_constraints_base;
     @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
 }
 
-sub _type {
+sub type {
     my $pkg = caller(0);
     my($name, %conf) = @_;
-    if (my $type = $TYPE{$name}) {
+    if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     };
     my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
@@ -99,10 +84,10 @@ sub _type {
     $TYPE{$name} = $constraint;
 }
 
-sub _subtype {
+sub subtype {
     my $pkg = caller(0);
     my($name, %conf) = @_;
-    if (my $type = $TYPE{$name}) {
+    if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     };
     my $constraint = $conf{where} || do { $TYPE{delete $conf{as} || 'Any' } };
@@ -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,20 +124,19 @@ sub _coerce {
     }
 }
 
-sub _class_type {
+sub class_type {
     my $pkg = caller(0);
     my($name, $conf) = @_;
     my $class = $conf->{class};
-    Mouse::load_class($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);
@@ -177,6 +161,27 @@ sub typecast_constraints {
     return $value;
 }
 
+my $serial_enum = 0;
+sub enum {
+    # enum ['small', 'medium', 'large']
+    if (ref($_[0]) eq 'ARRAY') {
+        my @elements = @{ shift @_ };
+
+        my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
+                 . ++$serial_enum;
+        enum($name, @elements);
+        return $name;
+    }
+
+    # enum size => 'small', 'medium', 'large'
+    my $name = shift;
+    my %is_valid = map { $_ => 1 } @_;
+
+    subtype(
+        $name => where => sub { $is_valid{$_} }
+    );
+}
+
 1;
 
 __END__