changes-and-comments

[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 75dc8a6..68ed3ee 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -12,14 +12,19 @@ our $VERSION = '0.05';
 use Moose::Meta::TypeConstraint;
 use Moose::Meta::TypeCoercion;
 
-sub import {
-       shift;
-       my $pkg = shift || caller();
-       return if $pkg eq '-no-export';
-       no strict 'refs';
-       foreach my $export (qw(type subtype as where message coerce from via find_type_constraint)) {
-               *{"${pkg}::${export}"} = \&{"${export}"};
-       }       
+{
+    require Sub::Exporter;
+    
+    my @exports = qw[type subtype as where message coerce from via find_type_constraint enum];
+
+    Sub::Exporter->import( 
+        -setup => { 
+            exports => \@exports,
+            groups  => {
+                default => [':all']
+            }
+        }
+    );
 }
 
 {
@@ -64,6 +69,15 @@ sub import {
         $type->coercion($type_coercion);
     }
     
+    sub create_type_constraint_union {
+        my (@type_constraint_names) = @_;
+        return Moose::Meta::TypeConstraint->union(
+            map { 
+                find_type_constraint($_) 
+            } @type_constraint_names
+        );
+    }
+    
     sub export_type_contstraints_as_functions {
         my $pkg = caller();
            no strict 'refs';
@@ -96,25 +110,37 @@ sub where   (&) { $_[0] }
 sub via     (&) { $_[0] }
 sub message (&) { $_[0] }
 
-# define some basic types
+sub enum {
+    my ($type_name, @values) = @_;
+    my $regexp = join '|' => @values;
+       _create_type_constraint(
+           $type_name,
+           'Str',
+           sub { qr/^$regexp$/i }
+       );    
+}
 
-type 'Any' => where { 1 };
+# define some basic types
 
-subtype 'Value' => as 'Any' => where { !ref($_) };
-subtype 'Ref'   => as 'Any' => where {  ref($_) };
+type 'Any'  => where { 1 }; # meta-type including all
+type 'Item' => where { 1 }; # base-type 
 
-subtype 'Bool' => as 'Any' => where { "$_" eq '1' || "$_" eq '0' };
+subtype 'Undef'   => as 'Item' => where { !defined($_) };
+subtype 'Defined' => as 'Item' => where {  defined($_) };
 
-subtype 'Int' => as 'Value' => where {  Scalar::Util::looks_like_number($_) };
-subtype 'Str' => as 'Value' => where { !Scalar::Util::looks_like_number($_) };
+subtype 'Bool'  => as 'Item' => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
 
-subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' };      
+subtype 'Value' => as 'Defined' => where { !ref($_) };
+subtype 'Ref'   => as 'Defined' => where {  ref($_) };
 
-subtype 'CollectionRef' => as 'Ref' => where { ref($_) eq 'ARRAY' || ref($_) eq 'HASH' };
+subtype 'Str' => as 'Value' => where { 1 };
 
-subtype 'ArrayRef' => as 'CollectionRef' => where { ref($_) eq 'ARRAY'  };
-subtype 'HashRef'  => as 'CollectionRef' => where { ref($_) eq 'HASH'   };     
+subtype 'Num' => as 'Value' => where { Scalar::Util::looks_like_number($_) };
+subtype 'Int' => as 'Num'   => where { "$_" =~ /^-?[0-9]+$/ };
 
+subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' };
+subtype 'ArrayRef'  => as 'Ref' => where { ref($_) eq 'ARRAY'  };
+subtype 'HashRef'   => as 'Ref' => where { ref($_) eq 'HASH'   };      
 subtype 'CodeRef'   => as 'Ref' => where { ref($_) eq 'CODE'   };
 subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' };      
 
@@ -152,6 +178,8 @@ Moose::Util::TypeConstraints - Type constraint system for Moose
   coerce Num 
       => from Str
         => via { 0+$_ }; 
+        
+  enum RGBColors => qw(red green blue);
 
 =head1 DESCRIPTION
 
@@ -174,19 +202,22 @@ This module also provides a simple hierarchy for Perl 5 types, this
 could probably use some work, but it works for me at the moment.
 
   Any
+  Item 
       Bool
-      Value
-          Int
-          Str
-      Ref
-          ScalarRef
-          CollectionRef
+      Undef
+      Defined
+          Value
+              Num
+                Int
+              Str
+          Ref
+              ScalarRef
               ArrayRef
               HashRef
-          CodeRef
-          RegexpRef
-          Object       
-              Role
+              CodeRef
+              RegexpRef
+              Object   
+                  Role
 
 Suggestions for improvement are welcome.
     
@@ -201,6 +232,11 @@ Suggestions for improvement are welcome.
 This function can be used to locate a specific type constraint 
 meta-object. What you do with it from there is up to you :)
 
+=item B<create_type_constraint_union (@type_constraint_names)>
+
+Given a list of C<@type_constraint_names>, this will return a 
+B<Moose::Meta::TypeConstraint::Union> instance.
+
 =item B<export_type_contstraints_as_functions>
 
 This will export all the current type constraints as functions 
@@ -233,6 +269,8 @@ This creates an unnamed subtype and will return the type
 constraint meta-object, which will be an instance of 
 L<Moose::Meta::TypeConstraint>. 
 
+=item B<enum ($name, @values)>
+
 =item B<as>
 
 This is just sugar for the type constraint construction syntax.
@@ -290,4 +328,4 @@ L<http://www.iinteractive.com>
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself. 
 
-=cut
\ No newline at end of file
+=cut