lib/SQL/Translator/Schema/Trigger.pm

   1 package SQL::Translator::Schema::Trigger;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Trigger.pm,v 1.7 2005-06-29 22:02:29 duality72 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.7 $ =~ /(\d+)\.(\d+)/;
  58
  59 # ----------------------------------------------------------------------
  60
  61 __PACKAGE__->_attributes( qw/
  62     name perform_action_when database_event fields on_table action schema
  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 on_table {
 175
 176 =pod
 177
 178 =head2 on_table
 179
 180 Gets or set the table name on which the trigger works.
 181
 182   $trigger->table('foo');
 183
 184 =cut
 185
 186     my $self = shift;
 187     my $arg  = shift || '';
 188     $self->{'on_table'} = $arg if $arg;
 189     return $self->{'on_table'};
 190 }
 191
 192 # ----------------------------------------------------------------------
 193 sub action {
 194
 195 =pod
 196
 197 =head2 action
 198
 199 Gets or set the actions of the trigger.
 200
 201   $trigger->actions(
 202       q[
 203         BEGIN
 204           select ...;
 205           update ...;
 206         END
 207       ]
 208   );
 209
 210 =cut
 211
 212     my $self = shift;
 213     my $arg  = shift || '';
 214     $self->{'action'} = $arg if $arg;
 215     return $self->{'action'};
 216 }
 217
 218 # ----------------------------------------------------------------------
 219 sub is_valid {
 220
 221 =pod
 222
 223 =head2 is_valid
 224
 225 Determine whether the trigger is valid or not.
 226
 227   my $ok = $trigger->is_valid;
 228
 229 =cut
 230
 231     my $self = shift;
 232
 233     for my $attr (
 234         qw[ name perform_action_when database_event on_table action ]
 235     ) {
 236         return $self->error("No $attr") unless $self->$attr();
 237     }
 238
 239     return $self->error("Missing fields for UPDATE ON") if
 240         $self->database_event eq 'update_on' && !$self->fields;
 241
 242     return 1;
 243 }
 244
 245 # ----------------------------------------------------------------------
 246 sub name {
 247
 248 =pod
 249
 250 =head2 name
 251
 252 Get or set the trigger's name.
 253
 254   my $name = $trigger->name('foo');
 255
 256 =cut
 257
 258     my $self        = shift;
 259     $self->{'name'} = shift if @_;
 260     return $self->{'name'} || '';
 261 }
 262
 263 # ----------------------------------------------------------------------
 264 sub order {
 265
 266 =pod
 267
 268 =head2 order
 269
 270 Get or set the trigger's order.
 271
 272   my $order = $trigger->order(3);
 273
 274 =cut
 275
 276     my ( $self, $arg ) = @_;
 277
 278     if ( defined $arg && $arg =~ /^\d+$/ ) {
 279         $self->{'order'} = $arg;
 280     }
 281
 282     return $self->{'order'} || 0;
 283 }
 284
 285 # ----------------------------------------------------------------------
 286 sub schema {
 287
 288 =pod
 289
 290 =head2 schema
 291
 292 Get or set the trigger's schema object.
 293
 294   $trigger->schema( $schema );
 295   my $schema = $trigger->schema;
 296
 297 =cut
 298
 299     my $self = shift;
 300     if ( my $arg = shift ) {
 301         return $self->error('Not a schema object') unless
 302             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
 303         $self->{'schema'} = $arg;
 304     }
 305
 306     return $self->{'schema'};
 307 }
 308
 309 # ----------------------------------------------------------------------
 310 sub equals {
 311
 312 =pod
 313
 314 =head2 equals
 315
 316 Determines if this trigger is the same as another
 317
 318   my $isIdentical = $trigger1->equals( $trigger2 );
 319
 320 =cut
 321
 322     my $self = shift;
 323     my $other = shift;
 324
 325     return 0 unless $self->SUPER::equals($other);
 326     return 0 unless $self->name eq $other->name;
 327     #return 0 unless $self->is_valid eq $other->is_valid;
 328     return 0 unless $self->perform_action_when eq $other->perform_action_when;
 329     return 0 unless $self->database_event eq $other->database_event;
 330     return 0 unless $self->on_table eq $other->on_table;
 331     return 0 unless $self->action eq $other->action;
 332     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 333     return 1;
 334 }
 335
 336 # ----------------------------------------------------------------------
 337 sub DESTROY {
 338     my $self = shift;
 339     undef $self->{'schema'}; # destroy cyclical reference
 340 }
 341
 342 1;
 343
 344 # ----------------------------------------------------------------------
 345
 346 =pod
 347
 348 =head1 AUTHOR
 349
 350 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 351
 352 =cut