From: Dagfinn Ilmari Mannsåker Date: Wed, 15 Aug 2012 22:15:07 +0000 (+0200) Subject: Add enum type X-Git-Tag: v0.11013_01~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4c3f67fa6fe92bdebe76194426ac141d66ee9b32;p=dbsrgits%2FSQL-Translator.git Add enum type --- diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm index 0261df7..2f4192b 100644 --- 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 --- 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 --- a/lib/SQL/Translator/Schema/Trigger.pm +++ b/lib/SQL/Translator/Schema/Trigger.pm @@ -30,7 +30,7 @@ C 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. 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 --- 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 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. + +=item icase + +If true, folds the values to lower case before checking for equality. + +=item allow_undef + +If true, allow C 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;