lib/SQL/Translator/Schema/Trigger.pm

   1 package SQL::Translator::Schema::Trigger;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Trigger.pm,v 1.9 2006-06-07 16:37:33 schiffbruechige Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =pod
  24
  25 =head1 NAME
  26
  27 SQL::Translator::Schema::Trigger - SQL::Translator trigger object
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator::Schema::Trigger;
  32   my $trigger = SQL::Translator::Schema::Trigger->new(
  33       name                => 'foo',
  34       perform_action_when => 'before', # or after
  35       database_event      => 'insert', # or update, update_on, delete
  36       fields              => [],       # fields if event is "update"
  37       on_table            => 'foo',    # table name
  38       action              => '...',    # text of trigger
  39       schema              => $schema,  # Schema object
  40   );
  41
  42 =head1 DESCRIPTION
  43
  44 C<SQL::Translator::Schema::Trigger> is the trigger object.
  45
  46 =head1 METHODS
  47
  48 =cut
  49
  50 use strict;
  51 use SQL::Translator::Utils 'parse_list_arg';
  52
  53 use base 'SQL::Translator::Schema::Object';
  54
  55 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
  56
  57 $VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
  58
  59 # ----------------------------------------------------------------------
  60
  61 __PACKAGE__->_attributes( qw/
  62     name schema perform_action_when database_event fields table on_table action
  63     order
  64 /);
  65
  66 =pod
  67
  68 =head2 new
  69
  70 Object constructor.
  71
  72   my $schema = SQL::Translator::Schema::Trigger->new;
  73
  74 =cut
  75
  76 # ----------------------------------------------------------------------
  77 sub perform_action_when {
  78
  79 =pod
  80
  81 =head2 perform_action_when
  82
  83 Gets or sets whether the event happens "before" or "after" the
  84 C<database_event>.
  85
  86   $trigger->perform_action_when('after');
  87
  88 =cut
  89
  90     my $self = shift;
  91
  92     if ( my $arg = shift ) {
  93         $arg =  lc $arg;
  94         $arg =~ s/\s+/ /g;
  95         if ( $arg =~ m/^(before|after)$/i ) {
  96             $self->{'perform_action_when'} = $arg;
  97         }
  98         else {
  99             return
 100                 $self->error("Invalid argument '$arg' to perform_action_when");
 101         }
 102     }
 103
 104     return $self->{'perform_action_when'};
 105 }
 106
 107 # ----------------------------------------------------------------------
 108 sub database_event {
 109
 110 =pod
 111
 112 =head2 database_event
 113
 114 Gets or sets the event that triggers the trigger.
 115
 116   my $ok = $trigger->database_event('insert');
 117
 118 =cut
 119
 120     my $self = shift;
 121
 122     if ( my $arg = shift ) {
 123         $arg =  lc $arg;
 124         $arg =~ s/\s+/ /g;
 125         if ( $arg =~ /^(insert|update|update_on|delete)$/ ) {
 126             $self->{'database_event'} = $arg;
 127         }
 128         else {
 129             return
 130                 $self->error("Invalid argument '$arg' to database_event");
 131         }
 132     }
 133
 134     return $self->{'database_event'};
 135 }
 136
 137 # ----------------------------------------------------------------------
 138 sub fields {
 139
 140 =pod
 141
 142 =head2 fields
 143
 144 Gets and set which fields to monitor for C<database_event>.
 145
 146   $view->fields('id');
 147   $view->fields('id', 'name');
 148   $view->fields( 'id, name' );
 149   $view->fields( [ 'id', 'name' ] );
 150   $view->fields( qw[ id name ] );
 151
 152   my @fields = $view->fields;
 153
 154 =cut
 155
 156     my $self = shift;
 157     my $fields = parse_list_arg( @_ );
 158
 159     if ( @$fields ) {
 160         my ( %unique, @unique );
 161         for my $f ( @$fields ) {
 162             next if $unique{ $f };
 163             $unique{ $f } = 1;
 164             push @unique, $f;
 165         }
 166
 167         $self->{'fields'} = \@unique;
 168     }
 169
 170     return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
 171 }
 172
 173 # ----------------------------------------------------------------------
 174 sub table {
 175
 176 =pod
 177
 178 =head2 table
 179
 180 Gets or set the table on which the trigger works, as a L<SQL::Translator::Schema::Table> object.
 181   $trigger->table($triggered_table);
 182
 183 =cut
 184
 185     my ($self, $arg) = @_;
 186     if ( @_ == 2 ) {
 187         $self->error("Table attribute of a ".__PACKAGE__.
 188                      " must be a SQL::Translator::Schema::Table")
 189             unless ref $arg and $arg->isa('SQL::Translator::Schema::Table');
 190         $self->{table} = $arg;
 191     }
 192     return $self->{table};
 193 }
 194
 195 # ----------------------------------------------------------------------
 196 sub on_table {
 197
 198 =pod
 199
 200 =head2 on_table
 201
 202 Gets or set the table name on which the trigger works, as a string.
 203   $trigger->on_table('foo');
 204
 205 =cut
 206
 207     my ($self, $arg) = @_;
 208     if ( @_ == 2 ) {
 209         my $table = $self->schema->get_table($arg);
 210         die "Table named $arg doesn't exist"
 211             if !$table;
 212         $self->table($table);
 213     }
 214     return $self->table->name;
 215 }
 216
 217 # ----------------------------------------------------------------------
 218 sub action {
 219
 220 =pod
 221
 222 =head2 action
 223
 224 Gets or set the actions of the trigger.
 225
 226   $trigger->actions(
 227       q[
 228         BEGIN
 229           select ...;
 230           update ...;
 231         END
 232       ]
 233   );
 234
 235 =cut
 236
 237     my $self = shift;
 238     my $arg  = shift || '';
 239     $self->{'action'} = $arg if $arg;
 240     return $self->{'action'};
 241 }
 242
 243 # ----------------------------------------------------------------------
 244 sub is_valid {
 245
 246 =pod
 247
 248 =head2 is_valid
 249
 250 Determine whether the trigger is valid or not.
 251
 252   my $ok = $trigger->is_valid;
 253
 254 =cut
 255
 256     my $self = shift;
 257
 258     for my $attr (
 259         qw[ name perform_action_when database_event on_table action ]
 260     ) {
 261         return $self->error("No $attr") unless $self->$attr();
 262     }
 263
 264     return $self->error("Missing fields for UPDATE ON") if
 265         $self->database_event eq 'update_on' && !$self->fields;
 266
 267     return 1;
 268 }
 269
 270 # ----------------------------------------------------------------------
 271 sub name {
 272
 273 =pod
 274
 275 =head2 name
 276
 277 Get or set the trigger's name.
 278
 279   my $name = $trigger->name('foo');
 280
 281 =cut
 282
 283     my $self        = shift;
 284     $self->{'name'} = shift if @_;
 285     return $self->{'name'} || '';
 286 }
 287
 288 # ----------------------------------------------------------------------
 289 sub order {
 290
 291 =pod
 292
 293 =head2 order
 294
 295 Get or set the trigger's order.
 296
 297   my $order = $trigger->order(3);
 298
 299 =cut
 300
 301     my ( $self, $arg ) = @_;
 302
 303     if ( defined $arg && $arg =~ /^\d+$/ ) {
 304         $self->{'order'} = $arg;
 305     }
 306
 307     return $self->{'order'} || 0;
 308 }
 309
 310 # ----------------------------------------------------------------------
 311 sub schema {
 312
 313 =pod
 314
 315 =head2 schema
 316
 317 Get or set the trigger's schema object.
 318
 319   $trigger->schema( $schema );
 320   my $schema = $trigger->schema;
 321
 322 =cut
 323
 324     my $self = shift;
 325     if ( my $arg = shift ) {
 326         return $self->error('Not a schema object') unless
 327             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
 328         $self->{'schema'} = $arg;
 329     }
 330
 331     return $self->{'schema'};
 332 }
 333
 334 # ----------------------------------------------------------------------
 335 sub equals {
 336
 337 =pod
 338
 339 =head2 equals
 340
 341 Determines if this trigger is the same as another
 342
 343   my $isIdentical = $trigger1->equals( $trigger2 );
 344
 345 =cut
 346
 347     my $self = shift;
 348     my $other = shift;
 349     my $case_insensitive = shift;
 350
 351     return 0 unless $self->SUPER::equals($other);
 352     return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
 353     #return 0 unless $self->is_valid eq $other->is_valid;
 354     return 0 unless $self->perform_action_when eq $other->perform_action_when;
 355     return 0 unless $self->database_event eq $other->database_event;
 356     return 0 unless $self->on_table eq $other->on_table;
 357     return 0 unless $self->action eq $other->action;
 358     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 359     return 1;
 360 }
 361
 362 # ----------------------------------------------------------------------
 363 sub DESTROY {
 364     my $self = shift;
 365     undef $self->{'schema'}; # destroy cyclical reference
 366 }
 367
 368 1;
 369
 370 # ----------------------------------------------------------------------
 371
 372 =pod
 373
 374 =head1 AUTHOR
 375
 376 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 377
 378 =cut