Add enum type

diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm
index 0261df7..2f4192b 100644 (file)
--- a/lib/SQL/Translator/Schema/Constraint.pm
+++ b/lib/SQL/Translator/Schema/Constraint.pm
@@ -27,7 +27,7 @@ use Moo 1.000003;
 use SQL::Translator::Schema::Constants;
 use SQL::Translator::Utils qw(ex2err throw);
 use SQL::Translator::Role::ListAttr;
-use SQL::Translator::Types qw(schema_obj);
+use SQL::Translator::Types qw(schema_obj enum);
 use Sub::Quote qw(quote_sub);
 
 extends 'SQL::Translator::Schema::Object';
@@ -227,11 +227,9 @@ has match_type => (
     is => 'rw',
     default => quote_sub(q{ '' }),
     coerce => quote_sub(q{ lc $_[0] }),
-    isa => sub {
-        my $arg = $_[0];
-        throw("Invalid match type: $arg")
-            if $arg && !($arg eq 'full' || $arg eq 'partial' || $arg eq 'simple');
-    },
+    isa => enum([qw(full partial simple)], {
+        msg => "Invalid match type: %s", allow_false => 1,
+    }),
 );
 
 around match_type => \&ex2err;
@@ -368,11 +366,10 @@ Get or set the constraint's type.
 has type => (
     is => 'rw',
     default => quote_sub(q{ '' }),
-    isa => sub {
-        throw("Invalid constraint type: $_[0]")
-            if $_[0] && !$VALID_CONSTRAINT_TYPE{ $_[0] };
-    },
     coerce => quote_sub(q{ (my $t = $_[0]) =~ s/_/ /g; uc $t }),
+    isa => enum([keys %VALID_CONSTRAINT_TYPE], {
+        msg => "Invalid constraint type: %s", allow_false => 1,
+    }),
 );
 
 around type => \&ex2err;

diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm
index 8537319..1c7769d 100644 (file)
--- a/lib/SQL/Translator/Schema/Index.pm
+++ b/lib/SQL/Translator/Schema/Index.pm
@@ -29,7 +29,7 @@ use Moo 1.000003;
 use SQL::Translator::Schema::Constants;
 use SQL::Translator::Utils qw(ex2err throw);
 use SQL::Translator::Role::ListAttr;
-use SQL::Translator::Types qw(schema_obj);
+use SQL::Translator::Types qw(schema_obj enum);
 use Sub::Quote qw(quote_sub);
 
 extends 'SQL::Translator::Schema::Object';
@@ -147,12 +147,11 @@ uppercase.
 
 has type => (
     is => 'rw',
-    isa => sub {
-        my $type = uc $_[0] or return;
-        throw("Invalid index type: $type") unless $VALID_INDEX_TYPE{$type};
-    },
     coerce => quote_sub(q{ uc $_[0] }),
     default => quote_sub(q{ 'NORMAL' }),
+    isa => enum([keys %VALID_INDEX_TYPE], {
+        msg => "Invalid index type: %s", allow_false => 1,
+    }),
 );
 
 around type => \&ex2err;

diff --git a/lib/SQL/Translator/Schema/Trigger.pm b/lib/SQL/Translator/Schema/Trigger.pm
index d643bba..7eab2af 100644 (file)
--- a/lib/SQL/Translator/Schema/Trigger.pm
+++ b/lib/SQL/Translator/Schema/Trigger.pm
@@ -30,7 +30,7 @@ C<SQL::Translator::Schema::Trigger> is the trigger object.
 
 use Moo 1.000003;
 use SQL::Translator::Utils qw(parse_list_arg ex2err throw);
-use SQL::Translator::Types qw(schema_obj);
+use SQL::Translator::Types qw(schema_obj enum);
 use List::MoreUtils qw(uniq);
 use Sub::Quote qw(quote_sub);
 
@@ -73,10 +73,10 @@ C<database_event>.
 has perform_action_when => (
     is => 'rw',
     coerce => quote_sub(q{ defined $_[0] ? lc $_[0] : $_[0] }),
-    isa => sub {
-        throw("Invalid argument '$_[0]' to perform_action_when")
-            if defined $_[0] and $_[0] !~ m/^(before|after)$/i;
-    },
+    isa => enum([qw(before after)], {
+        msg => "Invalid argument '%s' to perform_action_when",
+        allow_undef => 1,
+    }),
 );
 
 around perform_action_when => \&ex2err;
@@ -281,11 +281,9 @@ Get or set the trigger's scope (row or statement).
 
 has scope => (
     is => 'rw',
-    isa => sub {
-        my ($arg) = @_;
-        throw( "Invalid scope '$arg'" )
-            if defined $arg and $arg !~ /^(row|statement)$/i;
-    },
+    isa => enum([qw(row statement)], {
+        msg => "Invalid scope '%s'", icase => 1, allow_undef => 1,
+    }),
 );
 
 around scope => \&ex2err;

diff --git a/lib/SQL/Translator/Types.pm b/lib/SQL/Translator/Types.pm
index e76db93..208139e 100644 (file)
--- a/lib/SQL/Translator/Types.pm
+++ b/lib/SQL/Translator/Types.pm
@@ -8,9 +8,12 @@ SQL::Translator::Types - Type checking functions
 
     package Foo;
     use Moo;
-    use SQL::Translator::Types qw(schema_obj);
+    use SQL::Translator::Types qw(schema_obj enum);
 
     has foo => ( is => 'rw', isa => schema_obj('Trigger') );
+    has bar => ( is => 'rw', isa => enum([q(baz quux quuz)], {
+        msg => "Invalid value for bar: '%s'", icase => 1,
+    });
 
 =head1 DESCRIPTIONS
 
@@ -26,7 +29,7 @@ use SQL::Translator::Utils qw(throw);
 use Scalar::Util qw(blessed);
 
 use Exporter qw(import);
-our @EXPORT_OK = qw(schema_obj);
+our @EXPORT_OK = qw(schema_obj enum);
 
 =head1 FUNCTIONS
 
@@ -47,4 +50,56 @@ sub schema_obj {
     };
 }
 
+=head2 enum(\@strings, [$msg | \%parameters])
+
+Returns a coderef that checks that the argument is one of the provided
+C<@strings>.
+
+=head3 Parameters
+
+=over
+
+=item msg
+
+L<sprintf|perlfunc/sprintf> string for the error message.
+If no other parameters are needed, this can be provided on its own,
+instead of the C<%parameters> hashref.
+The invalid value is passed as the only argument.
+Defaults to C<Invalid value: '%s'>.
+
+=item icase
+
+If true, folds the values to lower case before checking for equality.
+
+=item allow_undef
+
+If true, allow C<undef> in addition to the specified strings.
+
+=item allow_false
+
+If true, allow any false value in addition to the specified strings.
+
+=back
+
+=cut
+
+sub enum {
+    my ($values, $args) = @_;
+    $args ||= {};
+    $args = { msg => $args } unless ref($args) eq 'HASH';
+    my $icase = !!$args->{icase};
+    my %values = map { ($icase ? lc : $_) => undef } @{$values};
+    my $msg = $args->{msg} || "Invalid value: '%s'";
+    my $extra_test =
+        $args->{allow_undef} ? sub { defined $_[0] } :
+        $args->{allow_false} ? sub { !!$_[0] } : undef;
+
+    return sub {
+        my $val = $icase ? lc $_[0] : $_[0];
+        throw(sprintf($msg, $val))
+            if (!defined($extra_test) || $extra_test->($val))
+                && !exists $values{$val};
+    };
+}
+
 1;