X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FTrigger.pm;h=83ff30f8222564dbdd4ff6f615e62aa96b7870fc;hb=ba506e52c480afe33dfec6b38a12759fad1e7fa2;hp=e93fc6b99db2bdcae5c3ba064d6107eba8b89269;hpb=4598b71c61d9fcb8a91ee6174a68a34d6f0eae24;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Trigger.pm b/lib/SQL/Translator/Schema/Trigger.pm index e93fc6b..83ff30f 100644 --- a/lib/SQL/Translator/Schema/Trigger.pm +++ b/lib/SQL/Translator/Schema/Trigger.pm @@ -1,9 +1,7 @@ package SQL::Translator::Schema::Trigger; # ---------------------------------------------------------------------- -# $Id: Trigger.pm,v 1.7 2005-06-29 22:02:29 duality72 Exp $ -# ---------------------------------------------------------------------- -# Copyright (C) 2002-4 SQLFairy Authors +# Copyright (C) 2002-2009 SQLFairy Authors # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -30,13 +28,13 @@ SQL::Translator::Schema::Trigger - SQL::Translator trigger object use SQL::Translator::Schema::Trigger; my $trigger = SQL::Translator::Schema::Trigger->new( - name => 'foo', - perform_action_when => 'before', # or after - database_event => 'insert', # or update, update_on, delete - fields => [], # fields if event is "update" - on_table => 'foo', # table name - action => '...', # text of trigger - schema => $schema, # Schema object + name => 'foo', + perform_action_when => 'before', # or after + database_events => [qw/update insert/], # also update, update_on, delete + fields => [], # if event is "update" + on_table => 'foo', # table name + action => '...', # text of trigger + schema => $schema, # Schema object ); =head1 DESCRIPTION @@ -52,15 +50,17 @@ use SQL::Translator::Utils 'parse_list_arg'; use base 'SQL::Translator::Schema::Object'; +use Carp; + use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.60'; # ---------------------------------------------------------------------- __PACKAGE__->_attributes( qw/ - name perform_action_when database_event fields on_table action schema - order + name schema perform_action_when database_events database_event + fields table on_table action order /); =pod @@ -111,27 +111,50 @@ sub database_event { =head2 database_event -Gets or sets the event that triggers the trigger. +Obsolete please use database_events! + +=cut + + my $self = shift; - my $ok = $trigger->database_event('insert'); + return $self->database_events( @_ ); +} + +# ---------------------------------------------------------------------- +sub database_events { + +=pod + +=head2 database_events + +Gets or sets the events that triggers the trigger. + + my $ok = $trigger->database_events('insert'); =cut my $self = shift; - - if ( my $arg = shift ) { - $arg = lc $arg; - $arg =~ s/\s+/ /g; - if ( $arg =~ /^(insert|update|update_on|delete)$/ ) { - $self->{'database_event'} = $arg; - } - else { - return - $self->error("Invalid argument '$arg' to database_event"); + my @args = ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_; + + if ( @args ) { + @args = map { s/\s+/ /g; lc $_ } @args; + my %valid = map { $_, 1 } qw[ insert update update_on delete ]; + my @invalid = grep { !defined $valid{ $_ } } @args; + + if ( @invalid ) { + return $self->error( + sprintf("Invalid events '%s' in database_events", + join(', ', @invalid) + ) + ); } + + $self->{'database_events'} = [ @args ]; } - return $self->{'database_event'}; + return wantarray + ? @{ $self->{'database_events'} || [] } + : $self->{'database_events'}; } # ---------------------------------------------------------------------- @@ -171,22 +194,47 @@ Gets and set which fields to monitor for C. } # ---------------------------------------------------------------------- +sub table { + +=pod + +=head2 table + +Gets or set the table on which the trigger works, as a L object. + $trigger->table($triggered_table); + +=cut + + my ($self, $arg) = @_; + if ( @_ == 2 ) { + $self->error("Table attribute of a ".__PACKAGE__. + " must be a SQL::Translator::Schema::Table") + unless ref $arg and $arg->isa('SQL::Translator::Schema::Table'); + $self->{table} = $arg; + } + return $self->{table}; +} + +# ---------------------------------------------------------------------- sub on_table { =pod =head2 on_table -Gets or set the table name on which the trigger works. - - $trigger->table('foo'); +Gets or set the table name on which the trigger works, as a string. + $trigger->on_table('foo'); =cut - my $self = shift; - my $arg = shift || ''; - $self->{'on_table'} = $arg if $arg; - return $self->{'on_table'}; + my ($self, $arg) = @_; + if ( @_ == 2 ) { + my $table = $self->schema->get_table($arg); + die "Table named $arg doesn't exist" + if !$table; + $self->table($table); + } + return $self->table->name; } # ---------------------------------------------------------------------- @@ -231,9 +279,9 @@ Determine whether the trigger is valid or not. my $self = shift; for my $attr ( - qw[ name perform_action_when database_event on_table action ] + qw[ name perform_action_when database_events on_table action ] ) { - return $self->error("No $attr") unless $self->$attr(); + return $self->error("Invalid: missing '$attr'") unless $self->$attr(); } return $self->error("Missing fields for UPDATE ON") if @@ -307,6 +355,35 @@ Get or set the trigger's schema object. } # ---------------------------------------------------------------------- +sub compare_arrays { + +=pod + +=head2 compare_arrays + +Compare two arrays. + +=cut + + my ($first, $second) = @_; + no warnings; # silence spurious -w undef complaints + + return 0 unless (ref $first eq 'ARRAY' and ref $second eq 'ARRAY' ) ; + + return 0 unless @$first == @$second; + + my @first = sort @$first; + + my @second = sort @$second; + + for (my $i = 0; $i < scalar @first; $i++) { + return 0 if @first[$i] ne @second[$i]; + } + + return 1; +} + +# ---------------------------------------------------------------------- sub equals { =pod @@ -315,21 +392,50 @@ sub equals { Determines if this trigger is the same as another - my $isIdentical = $trigger1->equals( $trigger2 ); + my $is_identical = $trigger1->equals( $trigger2 ); =cut - my $self = shift; - my $other = shift; + my $self = shift; + my $other = shift; + my $case_insensitive = shift; return 0 unless $self->SUPER::equals($other); - return 0 unless $self->name eq $other->name; - #return 0 unless $self->is_valid eq $other->is_valid; - return 0 unless $self->perform_action_when eq $other->perform_action_when; - return 0 unless $self->database_event eq $other->database_event; - return 0 unless $self->on_table eq $other->on_table; - return 0 unless $self->action eq $other->action; - return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra); + + my %names; + for my $name ( $self->name, $other->name ) { + $name = lc $name if $case_insensitive; + $names{ $name }++; + } + + if ( keys %names > 1 ) { + return $self->error('Names not equal'); + } + + if ( !$self->perform_action_when eq $other->perform_action_when ) { + return $self->error('perform_action_when differs'); + } + + if ( + !compare_arrays( [$self->database_events], [$other->database_events] ) + ) { + return $self->error('database_events differ'); + } + + if ( $self->on_table ne $other->on_table ) { + return $self->error('on_table differs'); + } + + if ( $self->action ne $other->action ) { + return $self->error('action differs'); + } + + if ( + !$self->_compare_objects( scalar $self->extra, scalar $other->extra ) + ) { + return $self->error('extras differ'); + } + return 1; } @@ -345,8 +451,9 @@ sub DESTROY { =pod -=head1 AUTHOR +=head1 AUTHORS -Ken Y. Clark Ekclark@cpan.orgE. +Anonymous, +Ken Youens-Clark Ekclark@cpan.orgE. =cut