Clean up option parsing and identifier quoting in Producer::PostgreSQL
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Trigger.pm
CommitLineData
e2cf647c 1package SQL::Translator::Schema::Trigger;
2
e2cf647c 3=pod
4
5=head1 NAME
6
7SQL::Translator::Schema::Trigger - SQL::Translator trigger object
8
9=head1 SYNOPSIS
10
11 use SQL::Translator::Schema::Trigger;
12 my $trigger = SQL::Translator::Schema::Trigger->new(
4348b2b4 13 name => 'foo',
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
c96cd4a8 20 scope => 'row', # or statement
e2cf647c 21 );
22
23=head1 DESCRIPTION
24
25C<SQL::Translator::Schema::Trigger> is the trigger object.
26
27=head1 METHODS
28
29=cut
30
90097ddd 31use Moo;
da0136cd 32use SQL::Translator::Utils qw(parse_list_arg ex2err throw);
4c3f67fa 33use SQL::Translator::Types qw(schema_obj enum);
da0136cd 34use List::MoreUtils qw(uniq);
68d75205 35use Sub::Quote qw(quote_sub);
e2cf647c 36
954ed12e 37extends 'SQL::Translator::Schema::Object';
b6a880d1 38
0c04c5a2 39our $VERSION = '1.59';
e2cf647c 40
e2cf647c 41=head2 new
42
43Object constructor.
44
45 my $schema = SQL::Translator::Schema::Trigger->new;
46
47=cut
48
da0136cd 49around BUILDARGS => sub {
50 my ($orig, $self, @args) = @_;
51 my $args = $self->$orig(@args);
52 if (exists $args->{on_table}) {
53 my $arg = delete $args->{on_table};
54 my $table = $args->{schema}->get_table($arg)
55 or die "Table named $arg doesn't exist";
56 $args->{table} = $table;
57 }
58 if (exists $args->{database_event}) {
59 $args->{database_events} = delete $args->{database_event};
60 }
61 return $args;
62};
e2cf647c 63
64=head2 perform_action_when
65
ea93df61 66Gets or sets whether the event happens "before" or "after" the
e2cf647c 67C<database_event>.
68
69 $trigger->perform_action_when('after');
70
71=cut
72
da0136cd 73has perform_action_when => (
74 is => 'rw',
c804300c 75 coerce => quote_sub(q{ defined $_[0] ? lc $_[0] : $_[0] }),
4c3f67fa 76 isa => enum([qw(before after)], {
77 msg => "Invalid argument '%s' to perform_action_when",
78 allow_undef => 1,
79 }),
da0136cd 80);
e2cf647c 81
da0136cd 82around perform_action_when => \&ex2err;
e2cf647c 83
e2cf647c 84sub database_event {
85
86=pod
87
88=head2 database_event
89
4348b2b4 90Obsolete please use database_events!
e2cf647c 91
92=cut
ea93df61 93
4348b2b4 94 my $self = shift;
95
96 return $self->database_events( @_ );
8742e408 97}
ea93df61 98
8742e408 99=head2 database_events
e2cf647c 100
8742e408 101Gets or sets the events that triggers the trigger.
102
d0fcb05d 103 my $ok = $trigger->database_events('insert');
8742e408 104
105=cut
106
da0136cd 107has database_events => (
108 is => 'rw',
c804300c 109 coerce => quote_sub(q{ [ map { lc } ref $_[0] eq 'ARRAY' ? @{$_[0]} : ($_[0]) ] }),
da0136cd 110 isa => sub {
111 my @args = @{$_[0]};
4348b2b4 112 my %valid = map { $_, 1 } qw[ insert update update_on delete ];
113 my @invalid = grep { !defined $valid{ $_ } } @args;
ea93df61 114
4348b2b4 115 if ( @invalid ) {
da0136cd 116 throw(
4348b2b4 117 sprintf("Invalid events '%s' in database_events",
118 join(', ', @invalid)
119 )
120 );
121 }
da0136cd 122 },
123);
4348b2b4 124
da0136cd 125around database_events => sub {
126 my ($orig,$self) = (shift, shift);
127
128 if (@_) {
129 ex2err($orig, $self, ref $_[0] eq 'ARRAY' ? $_[0] : \@_)
130 or return;
4348b2b4 131 }
132
ea93df61 133 return wantarray
da0136cd 134 ? @{ $self->$orig || [] }
135 : $self->$orig;
136};
e2cf647c 137
138=head2 fields
139
140Gets and set which fields to monitor for C<database_event>.
141
142 $view->fields('id');
143 $view->fields('id', 'name');
144 $view->fields( 'id, name' );
145 $view->fields( [ 'id', 'name' ] );
146 $view->fields( qw[ id name ] );
147
148 my @fields = $view->fields;
149
150=cut
151
da0136cd 152has fields => (
153 is => 'rw',
154 coerce => sub {
155 my @fields = uniq @{parse_list_arg($_[0])};
156 @fields ? \@fields : undef;
157 },
158);
159
160around fields => sub {
161 my $orig = shift;
162 my $self = shift;
e2cf647c 163 my $fields = parse_list_arg( @_ );
da0136cd 164 $self->$orig($fields) if @$fields;
e2cf647c 165
da0136cd 166 return wantarray ? @{ $self->$orig || [] } : $self->$orig;
167};
8ce5d615 168
169=head2 table
170
171Gets or set the table on which the trigger works, as a L<SQL::Translator::Schema::Table> object.
172 $trigger->table($triggered_table);
173
174=cut
175
a5bfeba8 176has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
da0136cd 177
178around table => \&ex2err;
8ce5d615 179
e2cf647c 180sub on_table {
181
182=pod
183
184=head2 on_table
185
8ce5d615 186Gets or set the table name on which the trigger works, as a string.
187 $trigger->on_table('foo');
e2cf647c 188
189=cut
190
8ce5d615 191 my ($self, $arg) = @_;
192 if ( @_ == 2 ) {
193 my $table = $self->schema->get_table($arg);
194 die "Table named $arg doesn't exist"
195 if !$table;
196 $self->table($table);
197 }
198 return $self->table->name;
e2cf647c 199}
200
e2cf647c 201=head2 action
202
cb490ce5 203Gets or set the action of the trigger.
e2cf647c 204
cb490ce5 205 $trigger->action(
e2cf647c 206 q[
207 BEGIN
208 select ...;
209 update ...;
210 END
211 ]
212 );
213
214=cut
215
68d75205 216has action => ( is => 'rw', default => quote_sub(q{ '' }) );
e2cf647c 217
e2cf647c 218sub is_valid {
219
220=pod
221
222=head2 is_valid
223
224Determine whether the trigger is valid or not.
225
226 my $ok = $trigger->is_valid;
227
228=cut
229
230 my $self = shift;
231
ea93df61 232 for my $attr (
233 qw[ name perform_action_when database_events on_table action ]
e2cf647c 234 ) {
4348b2b4 235 return $self->error("Invalid: missing '$attr'") unless $self->$attr();
e2cf647c 236 }
ea93df61 237
238 return $self->error("Missing fields for UPDATE ON") if
e2cf647c 239 $self->database_event eq 'update_on' && !$self->fields;
240
241 return 1;
242}
243
e2cf647c 244=head2 name
245
246Get or set the trigger's name.
247
248 my $name = $trigger->name('foo');
249
250=cut
251
68d75205 252has name => ( is => 'rw', default => quote_sub(q{ '' }) );
e2cf647c 253
254=head2 order
255
256Get or set the trigger's order.
257
258 my $order = $trigger->order(3);
259
260=cut
261
68d75205 262has order => ( is => 'rw', default => quote_sub(q{ 0 }) );
da0136cd 263
264around order => sub {
265 my ( $orig, $self, $arg ) = @_;
e2cf647c 266
267 if ( defined $arg && $arg =~ /^\d+$/ ) {
da0136cd 268 return $self->$orig($arg);
e2cf647c 269 }
270
da0136cd 271 return $self->$orig;
272};
c96cd4a8 273
274=head2 scope
275
276Get or set the trigger's scope (row or statement).
277
278 my $scope = $trigger->scope('statement');
279
280=cut
281
da0136cd 282has scope => (
283 is => 'rw',
4c3f67fa 284 isa => enum([qw(row statement)], {
285 msg => "Invalid scope '%s'", icase => 1, allow_undef => 1,
286 }),
da0136cd 287);
c96cd4a8 288
da0136cd 289around scope => \&ex2err;
c96cd4a8 290
39ad1787 291
292=head2 schema
293
294Get or set the trigger's schema object.
295
296 $trigger->schema( $schema );
297 my $schema = $trigger->schema;
298
299=cut
300
a5bfeba8 301has schema => (is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
39ad1787 302
da0136cd 303around schema => \&ex2err;
39ad1787 304
8742e408 305sub compare_arrays {
306
307=pod
308
309=head2 compare_arrays
310
311Compare two arrays.
312
313=cut
ea93df61 314
4348b2b4 315 my ($first, $second) = @_;
316 no warnings; # silence spurious -w undef complaints
317
318 return 0 unless (ref $first eq 'ARRAY' and ref $second eq 'ARRAY' ) ;
319
320 return 0 unless @$first == @$second;
321
322 my @first = sort @$first;
323
324 my @second = sort @$second;
325
326 for (my $i = 0; $i < scalar @first; $i++) {
327 return 0 if @first[$i] ne @second[$i];
328 }
329
330 return 1;
8742e408 331}
332
abf315bb 333=head2 equals
334
335Determines if this trigger is the same as another
336
4348b2b4 337 my $is_identical = $trigger1->equals( $trigger2 );
abf315bb 338
339=cut
340
da0136cd 341around equals => sub {
342 my $orig = shift;
4348b2b4 343 my $self = shift;
344 my $other = shift;
6be9534b 345 my $case_insensitive = shift;
ea93df61 346
da0136cd 347 return 0 unless $self->$orig($other);
4348b2b4 348
7f275a61 349 my %names;
ea93df61 350 for my $name ( $self->name, $other->name ) {
7f275a61 351 $name = lc $name if $case_insensitive;
352 $names{ $name }++;
353 }
4348b2b4 354
7f275a61 355 if ( keys %names > 1 ) {
356 return $self->error('Names not equal');
357 }
4348b2b4 358
7f275a61 359 if ( !$self->perform_action_when eq $other->perform_action_when ) {
360 return $self->error('perform_action_when differs');
361 }
362
ea93df61 363 if (
364 !compare_arrays( [$self->database_events], [$other->database_events] )
7f275a61 365 ) {
366 return $self->error('database_events differ');
367 }
4348b2b4 368
7f275a61 369 if ( $self->on_table ne $other->on_table ) {
370 return $self->error('on_table differs');
371 }
4348b2b4 372
7f275a61 373 if ( $self->action ne $other->action ) {
374 return $self->error('action differs');
375 }
4348b2b4 376
ea93df61 377 if (
7f275a61 378 !$self->_compare_objects( scalar $self->extra, scalar $other->extra )
379 ) {
380 return $self->error('extras differ');
381 }
4348b2b4 382
abf315bb 383 return 1;
da0136cd 384};
abf315bb 385
da0136cd 386# Must come after all 'has' declarations
387around new => \&ex2err;
388
e2cf647c 3891;
390
e2cf647c 391=pod
392
4348b2b4 393=head1 AUTHORS
e2cf647c 394
4348b2b4 395Anonymous,
396Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
e2cf647c 397
398=cut