Made debugging work and it now exports its parse method.
[dbsrgits/SQL-Translator.git] / 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