lib/SQL/Translator/Schema/Trigger.pm

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