Fix broken POD links found by App::PodLinkChecker

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Constraint.pm

diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm
index 1e7ab9f..7742bf7 100644 (file)
--- a/lib/SQL/Translator/Schema/Constraint.pm
+++ b/lib/SQL/Translator/Schema/Constraint.pm
@@ -25,16 +25,12 @@ C<SQL::Translator::Schema::Constraint> is the constraint object.
 
 use Moo;
 use SQL::Translator::Schema::Constants;
-use SQL::Translator::Utils qw(parse_list_arg ex2err throw);
-use SQL::Translator::Types qw(schema_obj);
-use List::MoreUtils qw(uniq);
-
-with qw(
-  SQL::Translator::Schema::Role::BuildArgs
-  SQL::Translator::Schema::Role::Extra
-  SQL::Translator::Schema::Role::Error
-  SQL::Translator::Schema::Role::Compare
-);
+use SQL::Translator::Utils qw(ex2err throw);
+use SQL::Translator::Role::ListAttr;
+use SQL::Translator::Types qw(schema_obj enum);
+use Sub::Quote qw(quote_sub);
+
+extends 'SQL::Translator::Schema::Object';
 
 our $VERSION = '1.59';
 
@@ -84,7 +80,7 @@ around BUILDARGS => sub {
 
 Get or set whether the constraint is deferrable.  If not defined,
 then returns "1."  The argument is evaluated by Perl for True or
-False, so the following are eqivalent:
+False, so the following are equivalent:
 
   $deferrable = $field->deferrable(0);
   $deferrable = $field->deferrable('');
@@ -92,7 +88,11 @@ False, so the following are eqivalent:
 
 =cut
 
-has deferrable => ( is => 'rw', coerce => sub { $_[0] ? 1 : 0 }, default => sub { 1 } );
+has deferrable => (
+    is => 'rw',
+    coerce => quote_sub(q{ $_[0] ? 1 : 0 }),
+    default => quote_sub(q{ 1 }),
+);
 
 =head2 expression
 
@@ -102,7 +102,7 @@ Gets and set the expression used in a CHECK constraint.
 
 =cut
 
-has expression => ( is => 'rw', default => sub { '' } );
+has expression => ( is => 'rw', default => quote_sub(q{ '' }) );
 
 around expression => sub {
     my ($orig, $self, $arg) = @_;
@@ -179,7 +179,7 @@ names and keep them in order by the first occurrence of a field name.
 
 The fields are returned as Field objects if they exist or as plain
 names if not. (If you just want the names and want to avoid the Field's overload
-magic use L<field_names>).
+magic use L</field_names>).
 
 Returns undef or an empty list if the constraint has no fields set.
 
@@ -196,9 +196,9 @@ Returns undef or an empty list if the constraint has no fields set.
 sub fields {
     my $self = shift;
     my $table = $self->table;
-    my @tables = map { $table->get_field($_) || $_ } @{$self->field_names(@_) || []};
-    return wantarray ? @tables
-        : @tables ? \@tables
+    my @fields = map { $table->get_field($_) || $_ } @{$self->field_names(@_) || []};
+    return wantarray ? @fields
+        : @fields ? \@fields
         : undef;
 }
 
@@ -212,23 +212,7 @@ avoid the overload magic of the Field objects returned by the fields method.
 
 =cut
 
-has field_names => (
-    is => 'rw',
-    default => sub { [] },
-    coerce => sub { [uniq @{parse_list_arg($_[0])}] },
-);
-
-around field_names => sub {
-    my $orig   = shift;
-    my $self   = shift;
-    my $fields = parse_list_arg( @_ );
-    $self->$orig($fields) if @$fields;
-
-    $fields = $self->$orig;
-    return wantarray ? @{$fields}
-        : @{$fields} ? $fields
-        : undef;
-};
+with ListAttr field_names => ( uniq => 1, undef_if_empty => 1 );
 
 =head2 match_type
 
@@ -241,13 +225,11 @@ Get or set the constraint's match_type.  Only valid values are "full"
 
 has match_type => (
     is => 'rw',
-    default => sub { '' },
-    coerce => sub { lc $_[0] },
-    isa => sub {
-        my $arg = $_[0];
-        throw("Invalid match type: $arg")
-            if $arg && !($arg eq 'full' || $arg eq 'partial' || $arg eq 'simple');
-    },
+    default => quote_sub(q{ '' }),
+    coerce => quote_sub(q{ lc $_[0] }),
+    isa => enum([qw(full partial simple)], {
+        msg => "Invalid match type: %s", allow_false => 1,
+    }),
 );
 
 around match_type => \&ex2err;
@@ -260,7 +242,7 @@ Get or set the constraint's name.
 
 =cut
 
-has name => ( is => 'rw', default => sub { '' } );
+has name => ( is => 'rw', default => quote_sub(q{ '' }) );
 
 around name => sub {
     my ($orig, $self, $arg) = @_;
@@ -277,17 +259,7 @@ Returns an array or array reference.
 
 =cut
 
-has options => ( is => 'rw', coerce => \&parse_list_arg, default => sub { [] } );
-
-around options => sub {
-    my $orig    = shift;
-    my $self    = shift;
-    my $options = parse_list_arg( @_ );
-
-    push @{ $self->$orig }, @$options;
-
-    return wantarray ? @{ $self->$orig } : $self->$orig;
-};
+with ListAttr options => ();
 
 =head2 on_delete
 
@@ -297,7 +269,7 @@ Get or set the constraint's "on delete" action.
 
 =cut
 
-has on_delete => ( is => 'rw', default => sub { '' } );
+has on_delete => ( is => 'rw', default => quote_sub(q{ '' }) );
 
 around on_delete => sub {
     my ($orig, $self, $arg) = @_;
@@ -312,7 +284,7 @@ Get or set the constraint's "on update" action.
 
 =cut
 
-has on_update => ( is => 'rw', default => sub { '' } );
+has on_update => ( is => 'rw', default => quote_sub(q{ '' }) );
 
 around on_update => sub {
     my ($orig, $self, $arg) = @_;
@@ -334,23 +306,12 @@ arrayref; returns an array or array reference.
 
 =cut
 
-has reference_fields => (
-    is => 'rw',
-    coerce => sub { [uniq @{parse_list_arg($_[0])}] },
+with ListAttr reference_fields => (
+    may_throw => 1,
     builder => 1,
     lazy => 1,
 );
 
-around reference_fields => sub {
-    my $orig   = shift;
-    my $self   = shift;
-    my $fields = parse_list_arg( @_ );
-    $self->$orig($fields) if @$fields;
-
-    $fields = ex2err($orig, $self) or return;
-    return wantarray ? @{$fields} : $fields
-};
-
 sub _build_reference_fields {
     my ($self) = @_;
 
@@ -380,7 +341,7 @@ Get or set the table referred to by the constraint.
 
 =cut
 
-has reference_table => ( is => 'rw', default => sub { '' } );
+has reference_table => ( is => 'rw', default => quote_sub(q{ '' }) );
 
 =head2 table
 
@@ -390,7 +351,7 @@ Get or set the constraint's table object.
 
 =cut
 
-has table => ( is => 'rw', isa => schema_obj('Table') );
+has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
 
 around table => \&ex2err;
 
@@ -404,12 +365,11 @@ Get or set the constraint's type.
 
 has type => (
     is => 'rw',
-    default => sub { '' },
-    isa => sub {
-        throw("Invalid constraint type: $_[0]")
-            if $_[0] && !$VALID_CONSTRAINT_TYPE{ $_[0] };
-    },
-    coerce => sub { (my $t = $_[0]) =~ s/_/ /g; uc $t },
+    default => quote_sub(q{ '' }),
+    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;
@@ -477,11 +437,6 @@ around equals => sub {
     return 1;
 };
 
-sub DESTROY {
-    my $self = shift;
-    undef $self->{'table'}; # destroy cyclical reference
-}
-
 # Must come after all 'has' declarations
 around new => \&ex2err;