lib/SQL/Translator/Schema/Trigger.pm

   1 package SQL::Translator::Schema::Trigger;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Trigger.pm,v 1.4 2004-11-04 16:29:56 grommit 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.4 $ =~ /(\d+)\.(\d+)/;
  58
  59 # ----------------------------------------------------------------------
  60 sub init {
  61
  62 =pod
  63
  64 =head2 new
  65
  66 Object constructor.
  67
  68   my $schema = SQL::Translator::Schema::Trigger->new;
  69
  70 =cut
  71
  72     my ( $self, $config ) = @_;
  73
  74     for my $arg (
  75         qw[
  76             name perform_action_when database_event fields
  77             on_table action schema
  78         ]
  79     ) {
  80         next unless $config->{ $arg };
  81         $self->$arg( $config->{ $arg } );# or return;
  82     }
  83
  84     return $self;
  85 }
  86
  87 # ----------------------------------------------------------------------
  88 sub perform_action_when {
  89
  90 =pod
  91
  92 =head2 perform_action_when
  93
  94 Gets or sets whether the event happens "before" or "after" the
  95 C<database_event>.
  96
  97   $trigger->perform_action_when('after');
  98
  99 =cut
 100
 101     my $self = shift;
 102
 103     if ( my $arg = shift ) {
 104         $arg =  lc $arg;
 105         $arg =~ s/\s+/ /g;
 106         if ( $arg =~ m/^(before|after)$/i ) {
 107             $self->{'perform_action_when'} = $arg;
 108         }
 109         else {
 110             return
 111                 $self->error("Invalid argument '$arg' to perform_action_when");
 112         }
 113     }
 114
 115     return $self->{'perform_action_when'};
 116 }
 117
 118 # ----------------------------------------------------------------------
 119 sub database_event {
 120
 121 =pod
 122
 123 =head2 database_event
 124
 125 Gets or sets the event that triggers the trigger.
 126
 127   my $ok = $trigger->database_event('insert');
 128
 129 =cut
 130
 131     my $self = shift;
 132
 133     if ( my $arg = shift ) {
 134         $arg =  lc $arg;
 135         $arg =~ s/\s+/ /g;
 136         if ( $arg =~ /^(insert|update|update_on|delete)$/ ) {
 137             $self->{'database_event'} = $arg;
 138         }
 139         else {
 140             return
 141                 $self->error("Invalid argument '$arg' to database_event");
 142         }
 143     }
 144
 145     return $self->{'database_event'};
 146 }
 147
 148 # ----------------------------------------------------------------------
 149 sub fields {
 150
 151 =pod
 152
 153 =head2 fields
 154
 155 Gets and set which fields to monitor for C<database_event>.
 156
 157   $view->fields('id');
 158   $view->fields('id', 'name');
 159   $view->fields( 'id, name' );
 160   $view->fields( [ 'id', 'name' ] );
 161   $view->fields( qw[ id name ] );
 162
 163   my @fields = $view->fields;
 164
 165 =cut
 166
 167     my $self = shift;
 168     my $fields = parse_list_arg( @_ );
 169
 170     if ( @$fields ) {
 171         my ( %unique, @unique );
 172         for my $f ( @$fields ) {
 173             next if $unique{ $f };
 174             $unique{ $f } = 1;
 175             push @unique, $f;
 176         }
 177
 178         $self->{'fields'} = \@unique;
 179     }
 180
 181     return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
 182 }
 183
 184 # ----------------------------------------------------------------------
 185 sub on_table {
 186
 187 =pod
 188
 189 =head2 on_table
 190
 191 Gets or set the table name on which the trigger works.
 192
 193   $trigger->table('foo');
 194
 195 =cut
 196
 197     my $self = shift;
 198     my $arg  = shift || '';
 199     $self->{'on_table'} = $arg if $arg;
 200     return $self->{'on_table'};
 201 }
 202
 203 # ----------------------------------------------------------------------
 204 sub action {
 205
 206 =pod
 207
 208 =head2 action
 209
 210 Gets or set the actions of the trigger.
 211
 212   $trigger->actions(
 213       q[
 214         BEGIN
 215           select ...;
 216           update ...;
 217         END
 218       ]
 219   );
 220
 221 =cut
 222
 223     my $self = shift;
 224     my $arg  = shift || '';
 225     $self->{'action'} = $arg if $arg;
 226     return $self->{'action'};
 227 }
 228
 229 # ----------------------------------------------------------------------
 230 sub is_valid {
 231
 232 =pod
 233
 234 =head2 is_valid
 235
 236 Determine whether the trigger is valid or not.
 237
 238   my $ok = $trigger->is_valid;
 239
 240 =cut
 241
 242     my $self = shift;
 243
 244     for my $attr (
 245         qw[ name perform_action_when database_event on_table action ]
 246     ) {
 247         return $self->error("No $attr") unless $self->$attr();
 248     }
 249
 250     return $self->error("Missing fields for UPDATE ON") if
 251         $self->database_event eq 'update_on' && !$self->fields;
 252
 253     return 1;
 254 }
 255
 256 # ----------------------------------------------------------------------
 257 sub name {
 258
 259 =pod
 260
 261 =head2 name
 262
 263 Get or set the trigger's name.
 264
 265   my $name = $trigger->name('foo');
 266
 267 =cut
 268
 269     my $self        = shift;
 270     $self->{'name'} = shift if @_;
 271     return $self->{'name'} || '';
 272 }
 273
 274 # ----------------------------------------------------------------------
 275 sub order {
 276
 277 =pod
 278
 279 =head2 order
 280
 281 Get or set the trigger's order.
 282
 283   my $order = $trigger->order(3);
 284
 285 =cut
 286
 287     my ( $self, $arg ) = @_;
 288
 289     if ( defined $arg && $arg =~ /^\d+$/ ) {
 290         $self->{'order'} = $arg;
 291     }
 292
 293     return $self->{'order'} || 0;
 294 }
 295
 296 # ----------------------------------------------------------------------
 297 sub schema {
 298
 299 =pod
 300
 301 =head2 schema
 302
 303 Get or set the trigger's schema object.
 304
 305   $trigger->schema( $schema );
 306   my $schema = $trigger->schema;
 307
 308 =cut
 309
 310     my $self = shift;
 311     if ( my $arg = shift ) {
 312         return $self->error('Not a schema object') unless
 313             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
 314         $self->{'schema'} = $arg;
 315     }
 316
 317     return $self->{'schema'};
 318 }
 319
 320 # ----------------------------------------------------------------------
 321 sub DESTROY {
 322     my $self = shift;
 323     undef $self->{'schema'}; # destroy cyclical reference
 324 }
 325
 326 1;
 327
 328 # ----------------------------------------------------------------------
 329
 330 =pod
 331
 332 =head1 AUTHOR
 333
 334 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 335
 336 =cut