1 package SQL::Translator::Schema::Trigger;
7 SQL::Translator::Schema::Trigger - SQL::Translator trigger object
11 use SQL::Translator::Schema::Trigger;
12 my $trigger = SQL::Translator::Schema::Trigger->new(
14 perform_action_when => 'before', # or after
15 database_events => [qw/update insert/], # also update, update_on, delete
16 fields => [], # if event is "update"
17 on_table => 'foo', # table name
18 action => '...', # text of trigger
19 schema => $schema, # Schema object
20 scope => 'row', # or statement
25 C<SQL::Translator::Schema::Trigger> is the trigger object.
32 use SQL::Translator::Utils qw(parse_list_arg ex2err throw);
33 use SQL::Translator::Types qw(schema_obj);
34 use List::MoreUtils qw(uniq);
37 SQL::Translator::Schema::Role::BuildArgs
38 SQL::Translator::Schema::Role::Extra
39 SQL::Translator::Schema::Role::Error
40 SQL::Translator::Schema::Role::Compare
43 our $VERSION = '1.59';
49 my $schema = SQL::Translator::Schema::Trigger->new;
53 around BUILDARGS => sub {
54 my ($orig, $self, @args) = @_;
55 my $args = $self->$orig(@args);
56 if (exists $args->{on_table}) {
57 my $arg = delete $args->{on_table};
58 my $table = $args->{schema}->get_table($arg)
59 or die "Table named $arg doesn't exist";
60 $args->{table} = $table;
62 if (exists $args->{database_event}) {
63 $args->{database_events} = delete $args->{database_event};
68 =head2 perform_action_when
70 Gets or sets whether the event happens "before" or "after" the
73 $trigger->perform_action_when('after');
77 has perform_action_when => (
79 coerce => sub { defined $_[0] ? lc $_[0] : $_[0] },
81 throw("Invalid argument '$_[0]' to perform_action_when")
82 if defined $_[0] and $_[0] !~ m/^(before|after)$/i;
86 around perform_action_when => \&ex2err;
94 Obsolete please use database_events!
100 return $self->database_events( @_ );
103 =head2 database_events
105 Gets or sets the events that triggers the trigger.
107 my $ok = $trigger->database_events('insert');
111 has database_events => (
113 coerce => sub { [ map { lc } ref $_[0] eq 'ARRAY' ? @{$_[0]} : ($_[0]) ] },
116 my %valid = map { $_, 1 } qw[ insert update update_on delete ];
117 my @invalid = grep { !defined $valid{ $_ } } @args;
121 sprintf("Invalid events '%s' in database_events",
129 around database_events => sub {
130 my ($orig,$self) = (shift, shift);
133 ex2err($orig, $self, ref $_[0] eq 'ARRAY' ? $_[0] : \@_)
138 ? @{ $self->$orig || [] }
144 Gets and set which fields to monitor for C<database_event>.
147 $view->fields('id', 'name');
148 $view->fields( 'id, name' );
149 $view->fields( [ 'id', 'name' ] );
150 $view->fields( qw[ id name ] );
152 my @fields = $view->fields;
159 my @fields = uniq @{parse_list_arg($_[0])};
160 @fields ? \@fields : undef;
164 around fields => sub {
167 my $fields = parse_list_arg( @_ );
168 $self->$orig($fields) if @$fields;
170 return wantarray ? @{ $self->$orig || [] } : $self->$orig;
175 Gets or set the table on which the trigger works, as a L<SQL::Translator::Schema::Table> object.
176 $trigger->table($triggered_table);
180 has table => ( is => 'rw', isa => schema_obj('Table') );
182 around table => \&ex2err;
190 Gets or set the table name on which the trigger works, as a string.
191 $trigger->on_table('foo');
195 my ($self, $arg) = @_;
197 my $table = $self->schema->get_table($arg);
198 die "Table named $arg doesn't exist"
200 $self->table($table);
202 return $self->table->name;
207 Gets or set the action of the trigger.
220 has action => ( is => 'rw', default => sub { '' } );
228 Determine whether the trigger is valid or not.
230 my $ok = $trigger->is_valid;
237 qw[ name perform_action_when database_events on_table action ]
239 return $self->error("Invalid: missing '$attr'") unless $self->$attr();
242 return $self->error("Missing fields for UPDATE ON") if
243 $self->database_event eq 'update_on' && !$self->fields;
250 Get or set the trigger's name.
252 my $name = $trigger->name('foo');
256 has name => ( is => 'rw', default => sub { '' } );
260 Get or set the trigger's order.
262 my $order = $trigger->order(3);
266 has order => ( is => 'rw', default => sub { 0 } );
268 around order => sub {
269 my ( $orig, $self, $arg ) = @_;
271 if ( defined $arg && $arg =~ /^\d+$/ ) {
272 return $self->$orig($arg);
280 Get or set the trigger's scope (row or statement).
282 my $scope = $trigger->scope('statement');
290 throw( "Invalid scope '$arg'" )
291 if defined $arg and $arg !~ /^(row|statement)$/i;
295 around scope => \&ex2err;
300 Get or set the trigger's schema object.
302 $trigger->schema( $schema );
303 my $schema = $trigger->schema;
307 has schema => (is => 'rw', isa => schema_obj('Schema') );
309 around schema => \&ex2err;
315 =head2 compare_arrays
321 my ($first, $second) = @_;
322 no warnings; # silence spurious -w undef complaints
324 return 0 unless (ref $first eq 'ARRAY' and ref $second eq 'ARRAY' ) ;
326 return 0 unless @$first == @$second;
328 my @first = sort @$first;
330 my @second = sort @$second;
332 for (my $i = 0; $i < scalar @first; $i++) {
333 return 0 if @first[$i] ne @second[$i];
341 Determines if this trigger is the same as another
343 my $is_identical = $trigger1->equals( $trigger2 );
347 around equals => sub {
351 my $case_insensitive = shift;
353 return 0 unless $self->$orig($other);
356 for my $name ( $self->name, $other->name ) {
357 $name = lc $name if $case_insensitive;
361 if ( keys %names > 1 ) {
362 return $self->error('Names not equal');
365 if ( !$self->perform_action_when eq $other->perform_action_when ) {
366 return $self->error('perform_action_when differs');
370 !compare_arrays( [$self->database_events], [$other->database_events] )
372 return $self->error('database_events differ');
375 if ( $self->on_table ne $other->on_table ) {
376 return $self->error('on_table differs');
379 if ( $self->action ne $other->action ) {
380 return $self->error('action differs');
384 !$self->_compare_objects( scalar $self->extra, scalar $other->extra )
386 return $self->error('extras differ');
392 # Must come after all 'has' declarations
393 around new => \&ex2err;
402 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.