X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FConstraint.pm;h=edf8752bdbca2ca3db5778613d370f82172059df;hb=2bdef63659f546187a4d1266e88aa66671b228b7;hp=e4f3a9d3d1af11a9e2a864720b580f77d34c994d;hpb=46ad748fcf9f976bb6ce2549f135023e3d66b2a8;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm index e4f3a9d..edf8752 100644 --- a/lib/SQL/Translator/Schema/Constraint.pm +++ b/lib/SQL/Translator/Schema/Constraint.pm @@ -23,20 +23,14 @@ C is the constraint object. =cut -use Moo; +use Moo 1.000003; use SQL::Translator::Schema::Constants; -use SQL::Translator::Utils qw(parse_list_arg ex2err throw); +use SQL::Translator::Utils qw(ex2err throw); +use SQL::Translator::Role::ListAttr; use SQL::Translator::Types qw(schema_obj); -use List::MoreUtils qw(uniq); +use Sub::Quote qw(quote_sub); -with qw( - SQL::Translator::Schema::Role::BuildArgs - SQL::Translator::Schema::Role::Extra - SQL::Translator::Schema::Role::Error - SQL::Translator::Schema::Role::Compare -); - - our ( $TABLE_COUNT, $VIEW_COUNT ); +extends 'SQL::Translator::Schema::Object'; our $VERSION = '1.59'; @@ -94,7 +88,7 @@ False, so the following are eqivalent: =cut -has deferrable => ( is => 'rw', coerce => sub { $_[0] ? 1 : 0 }, default => sub { 1 } ); +has deferrable => ( is => 'rw', coerce => sub { $_[0] ? 1 : 0 }, default => quote_sub(q{ 1 }) ); =head2 expression @@ -104,7 +98,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) = @_; @@ -214,23 +208,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 @@ -243,7 +221,7 @@ Get or set the constraint's match_type. Only valid values are "full" has match_type => ( is => 'rw', - default => sub { '' }, + default => quote_sub(q{ '' }), coerce => sub { lc $_[0] }, isa => sub { my $arg = $_[0]; @@ -262,7 +240,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) = @_; @@ -279,17 +257,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 @@ -299,7 +267,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) = @_; @@ -314,7 +282,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) = @_; @@ -336,23 +304,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) = @_; @@ -382,7 +339,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 @@ -392,7 +349,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; @@ -406,7 +363,7 @@ Get or set the constraint's type. has type => ( is => 'rw', - default => sub { '' }, + default => quote_sub(q{ '' }), isa => sub { throw("Invalid constraint type: $_[0]") if $_[0] && !$VALID_CONSTRAINT_TYPE{ $_[0] }; @@ -479,11 +436,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;