[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Trigger.pm

package SQL::Translator::Schema::Trigger;

# ----------------------------------------------------------------------
# $Id$
# ----------------------------------------------------------------------
# Copyright (C) 2002-2009 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=pod

=head1 NAME

SQL::Translator::Schema::Trigger - SQL::Translator trigger object

=head1 SYNOPSIS

  use SQL::Translator::Schema::Trigger;
  my $trigger = SQL::Translator::Schema::Trigger->new(
      name                => 'foo',
      perform_action_when => 'before', # or after
      database_event      => 'insert', # Obsolete please use database_events!
	  database_events     => [qw/update instert/], # or update, update_on, delete
      fields              => [],       # fields if event is "update"
      on_table            => 'foo',    # table name
      action              => '...',    # text of trigger
      schema              => $schema,  # Schema object
  );

=head1 DESCRIPTION

C<SQL::Translator::Schema::Trigger> is the trigger object.

=head1 METHODS

=cut

use strict;
use SQL::Translator::Utils 'parse_list_arg';

use base 'SQL::Translator::Schema::Object';

use vars qw($TABLE_COUNT $VIEW_COUNT);

# ----------------------------------------------------------------------

__PACKAGE__->_attributes( qw/
    name schema perform_action_when database_event database_events fields table on_table action
    order
/);

=pod

=head2 new

Object constructor.

  my $schema = SQL::Translator::Schema::Trigger->new;

=cut

# ----------------------------------------------------------------------
sub perform_action_when {

=pod

=head2 perform_action_when

Gets or sets whether the event happens "before" or "after" the 
C<database_event>.

  $trigger->perform_action_when('after');

=cut

    my $self = shift;
    
    if ( my $arg = shift ) {
        $arg =  lc $arg;
        $arg =~ s/\s+/ /g;
        if ( $arg =~ m/^(before|after)$/i ) {
            $self->{'perform_action_when'} = $arg;
        }
        else {
            return 
                $self->error("Invalid argument '$arg' to perform_action_when");
        }
    }

    return $self->{'perform_action_when'};
}

# ----------------------------------------------------------------------
sub database_event {

=pod

=head2 database_event

Obosolete please use database_events!

=cut
    
	my $self = shift;
	
	
	if ( my $arg = shift ) {
		$self->database_events( [$arg] );
	}

	return $self->error("Please use database_events the trigger has more then one events!") if (scalar @{$self->{'database_events'}} > 1);
	
    warn 'database_event is obsolete please use database_events';
	return (@{ $self->{'database_events'} })[0];
}
# ----------------------------------------------------------------------
sub database_events {

=pod

=head2 database_events

Gets or sets the events that triggers the trigger.

  my $ok = $trigger->database_event('insert');

=cut

	my $self = shift;
	
	if ( my $arg = shift ) {
		if (ref $arg eq "ARRAY"){
			map  {
				$_ = lc; 
				$_ =~ s/\s+/ /g;  
				return $self->error("Invalid event '$_' in database_events") unless ( $_ =~ /^(insert|update|update_on|delete)$/ );
			} @$arg ;
			@{ $self->{'database_events'} } = @$arg;
			
		}else{
			return $self->error("Invalid argument to database_events");
		};
		
	}

	return $self->{'database_events'};
}

# ----------------------------------------------------------------------
sub fields {

=pod

=head2 fields

Gets and set which fields to monitor for C<database_event>.

  $view->fields('id');
  $view->fields('id', 'name');
  $view->fields( 'id, name' );
  $view->fields( [ 'id', 'name' ] );
  $view->fields( qw[ id name ] );

  my @fields = $view->fields;

=cut

    my $self = shift;
    my $fields = parse_list_arg( @_ );

    if ( @$fields ) {
        my ( %unique, @unique );
        for my $f ( @$fields ) {
            next if $unique{ $f };
            $unique{ $f } = 1;
            push @unique, $f;
        }

        $self->{'fields'} = \@unique;
    }

    return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
}

# ----------------------------------------------------------------------
sub table {

=pod

=head2 table

Gets or set the table on which the trigger works, as a L<SQL::Translator::Schema::Table> object.
  $trigger->table($triggered_table);

=cut

    my ($self, $arg) = @_;
    if ( @_ == 2 ) {
        $self->error("Table attribute of a ".__PACKAGE__.
                     " must be a SQL::Translator::Schema::Table") 
            unless ref $arg and $arg->isa('SQL::Translator::Schema::Table');
        $self->{table} = $arg;
    }
    return $self->{table};
}

# ----------------------------------------------------------------------
sub on_table {

=pod

=head2 on_table

Gets or set the table name on which the trigger works, as a string.
  $trigger->on_table('foo');

=cut

    my ($self, $arg) = @_;
    if ( @_ == 2 ) {
        my $table = $self->schema->get_table($arg);
        die "Table named $arg doesn't exist"
            if !$table;
        $self->table($table);
    }
    return $self->table->name;
}

# ----------------------------------------------------------------------
sub action {

=pod

=head2 action

Gets or set the actions of the trigger.

  $trigger->actions(
      q[
        BEGIN
          select ...;
          update ...;
        END
      ]
  );

=cut

    my $self = shift;
    my $arg  = shift || '';
    $self->{'action'} = $arg if $arg;
    return $self->{'action'};
}

# ----------------------------------------------------------------------
sub is_valid {

=pod

=head2 is_valid

Determine whether the trigger is valid or not.

  my $ok = $trigger->is_valid;

=cut

    my $self = shift;

    for my $attr ( 
        qw[ name perform_action_when database_event on_table action ] 
    ) {
        return $self->error("No $attr") unless $self->$attr();
    }
    
    return $self->error("Missing fields for UPDATE ON") if 
        $self->database_event eq 'update_on' && !$self->fields;

    return 1;
}

# ----------------------------------------------------------------------
sub name {

=pod

=head2 name

Get or set the trigger's name.

  my $name = $trigger->name('foo');

=cut

    my $self        = shift;
    $self->{'name'} = shift if @_;
    return $self->{'name'} || '';
}

# ----------------------------------------------------------------------
sub order {

=pod

=head2 order

Get or set the trigger's order.

  my $order = $trigger->order(3);

=cut

    my ( $self, $arg ) = @_;

    if ( defined $arg && $arg =~ /^\d+$/ ) {
        $self->{'order'} = $arg;
    }

    return $self->{'order'} || 0;
}

# ----------------------------------------------------------------------
sub schema {

=pod

=head2 schema

Get or set the trigger's schema object.

  $trigger->schema( $schema );
  my $schema = $trigger->schema;

=cut

    my $self = shift;
    if ( my $arg = shift ) {
        return $self->error('Not a schema object') unless
            UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
        $self->{'schema'} = $arg;
    }

    return $self->{'schema'};
}

# ----------------------------------------------------------------------
sub compare_arrays {

=pod

=head2 compare_arrays

Compare two arrays.

=cut
	
	my ($first, $second) = @_;
	no warnings;  # silence spurious -w undef complaints

	return 0 unless (ref $first eq 'ARRAY' and ref $second eq 'ARRAY' ) ;
	return 0 unless @$first == @$second;
	my @first = sort @$first;
	my @second = sort @$second;
	for (my $i = 0; $i < scalar @first; $i++) {
		return 0 if @first[$i] ne @second[$i];
		}
	return 1;
}

# ----------------------------------------------------------------------
sub equals {

=pod

=head2 equals

Determines if this trigger is the same as another

  my $isIdentical = $trigger1->equals( $trigger2 );

=cut

    my $self = shift;
    my $other = shift;
    my $case_insensitive = shift;
    
    return 0 unless $self->SUPER::equals($other);
    return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
    #return 0 unless $self->is_valid eq $other->is_valid;
    return 0 unless $self->perform_action_when eq $other->perform_action_when;
    return 0 unless compare_arrays($self->database_events,$other->database_events) ;
    return 0 unless $self->on_table eq $other->on_table;
    return 0 unless $self->action eq $other->action;
    return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
    return 1;
}

# ----------------------------------------------------------------------
sub DESTROY {
    my $self = shift;
    undef $self->{'schema'}; # destroy cyclical reference
}

1;

# ----------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.

=cut
Commit	Line	Data
e2cf647c	1	package SQL::Translator::Schema::Trigger;
	2
	3	# ----------------------------------------------------------------------
821a0fde	4	# $Id$
e2cf647c	5	# ----------------------------------------------------------------------
478f608d	6	# Copyright (C) 2002-2009 SQLFairy Authors
e2cf647c	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
8742e408	35	database_event => 'insert', # Obsolete please use database_events!
8742e408	36	database_events => [qw/update instert/], # or update, update_on, delete
e2cf647c	37	fields => [], # fields if event is "update"
	38	on_table => 'foo', # table name
	39	action => '...', # text of trigger
39ad1787	40	schema => $schema, # Schema object
e2cf647c	41	);
	42
	43	=head1 DESCRIPTION
	44
	45	C<SQL::Translator::Schema::Trigger> is the trigger object.
	46
	47	=head1 METHODS
	48
	49	=cut
	50
	51	use strict;
e2cf647c	52	use SQL::Translator::Utils 'parse_list_arg';
e2cf647c	53
b6a880d1	54	use base 'SQL::Translator::Schema::Object';
b6a880d1	55
478f608d	56	use vars qw($TABLE_COUNT $VIEW_COUNT);
e2cf647c	57
e2cf647c	58	# ----------------------------------------------------------------------
9371be50	59
9371be50	60	__PACKAGE__->_attributes( qw/
8742e408	61	name schema perform_action_when database_event database_events fields table on_table action
9371be50	62	order
9371be50	63	/);
e2cf647c	64
	65	=pod
	66
	67	=head2 new
	68
	69	Object constructor.
	70
	71	my $schema = SQL::Translator::Schema::Trigger->new;
	72
	73	=cut
	74
e2cf647c	75	# ----------------------------------------------------------------------
	76	sub perform_action_when {
	77
	78	=pod
	79
	80	=head2 perform_action_when
	81
	82	Gets or sets whether the event happens "before" or "after" the
	83	C<database_event>.
	84
	85	$trigger->perform_action_when('after');
	86
	87	=cut
	88
	89	my $self = shift;
	90
	91	if ( my $arg = shift ) {
	92	$arg = lc $arg;
	93	$arg =~ s/\s+/ /g;
	94	if ( $arg =~ m/^(before\|after)$/i ) {
	95	$self->{'perform_action_when'} = $arg;
	96	}
	97	else {
	98	return
	99	$self->error("Invalid argument '$arg' to perform_action_when");
	100	}
	101	}
	102
	103	return $self->{'perform_action_when'};
	104	}
	105
	106	# ----------------------------------------------------------------------
	107	sub database_event {
	108
	109	=pod
	110
	111	=head2 database_event
	112
8742e408	113	Obosolete please use database_events!
e2cf647c	114
e2cf647c	115	=cut
8742e408	116
	117	my $self = shift;
	118
	119
	120	if ( my $arg = shift ) {
	121	$self->database_events( [$arg] );
	122	}
	123
	124	return $self->error("Please use database_events the trigger has more then one events!") if (scalar @{$self->{'database_events'}} > 1);
	125
	126	warn 'database_event is obsolete please use database_events';
	127	return (@{ $self->{'database_events'} })[0];
	128	}
	129	# ----------------------------------------------------------------------
	130	sub database_events {
e2cf647c	131
8742e408	132	=pod
e2cf647c	133
8742e408	134	=head2 database_events
e2cf647c	135
8742e408	136	Gets or sets the events that triggers the trigger.
	137
	138	my $ok = $trigger->database_event('insert');
	139
	140	=cut
	141
	142	my $self = shift;
	143
	144	if ( my $arg = shift ) {
	145	if (ref $arg eq "ARRAY"){
	146	map {
	147	$_ = lc;
	148	$_ =~ s/\s+/ /g;
	149	return $self->error("Invalid event '$_' in database_events") unless ( $_ =~ /^(insert\|update\|update_on\|delete)$/ );
	150	} @$arg ;
	151	@{ $self->{'database_events'} } = @$arg;
	152
	153	}else{
	154	return $self->error("Invalid argument to database_events");
	155	};
	156
	157	}
	158
	159	return $self->{'database_events'};
e2cf647c	160	}
	161
	162	# ----------------------------------------------------------------------
	163	sub fields {
	164
	165	=pod
	166
	167	=head2 fields
	168
	169	Gets and set which fields to monitor for C<database_event>.
	170
	171	$view->fields('id');
	172	$view->fields('id', 'name');
	173	$view->fields( 'id, name' );
	174	$view->fields( [ 'id', 'name' ] );
	175	$view->fields( qw[ id name ] );
	176
	177	my @fields = $view->fields;
	178
	179	=cut
	180
	181	my $self = shift;
	182	my $fields = parse_list_arg( @_ );
	183
	184	if ( @$fields ) {
	185	my ( %unique, @unique );
	186	for my $f ( @$fields ) {
	187	next if $unique{ $f };
	188	$unique{ $f } = 1;
	189	push @unique, $f;
	190	}
	191
	192	$self->{'fields'} = \@unique;
	193	}
	194
	195	return wantarray ? @{ $self->{'fields'} \|\| [] } : $self->{'fields'};
	196	}
	197
	198	# ----------------------------------------------------------------------
8ce5d615	199	sub table {
	200
	201	=pod
	202
	203	=head2 table
	204
	205	Gets or set the table on which the trigger works, as a L<SQL::Translator::Schema::Table> object.
	206	$trigger->table($triggered_table);
	207
	208	=cut
	209
	210	my ($self, $arg) = @_;
	211	if ( @_ == 2 ) {
	212	$self->error("Table attribute of a ".__PACKAGE__.
	213	" must be a SQL::Translator::Schema::Table")
	214	unless ref $arg and $arg->isa('SQL::Translator::Schema::Table');
	215	$self->{table} = $arg;
	216	}
	217	return $self->{table};
	218	}
	219
	220	# ----------------------------------------------------------------------
e2cf647c	221	sub on_table {
	222
	223	=pod
	224
	225	=head2 on_table
	226
8ce5d615	227	Gets or set the table name on which the trigger works, as a string.
8ce5d615	228	$trigger->on_table('foo');
e2cf647c	229
	230	=cut
	231
8ce5d615	232	my ($self, $arg) = @_;
	233	if ( @_ == 2 ) {
	234	my $table = $self->schema->get_table($arg);
	235	die "Table named $arg doesn't exist"
	236	if !$table;
	237	$self->table($table);
	238	}
	239	return $self->table->name;
e2cf647c	240	}
	241
	242	# ----------------------------------------------------------------------
	243	sub action {
	244
	245	=pod
	246
	247	=head2 action
	248
	249	Gets or set the actions of the trigger.
	250
	251	$trigger->actions(
	252	q[
	253	BEGIN
	254	select ...;
	255	update ...;
	256	END
	257	]
	258	);
	259
	260	=cut
	261
	262	my $self = shift;
	263	my $arg = shift \|\| '';
	264	$self->{'action'} = $arg if $arg;
	265	return $self->{'action'};
	266	}
	267
	268	# ----------------------------------------------------------------------
	269	sub is_valid {
	270
	271	=pod
	272
	273	=head2 is_valid
	274
	275	Determine whether the trigger is valid or not.
	276
	277	my $ok = $trigger->is_valid;
	278
	279	=cut
	280
	281	my $self = shift;
	282
	283	for my $attr (
	284	qw[ name perform_action_when database_event on_table action ]
	285	) {
	286	return $self->error("No $attr") unless $self->$attr();
	287	}
	288
	289	return $self->error("Missing fields for UPDATE ON") if
	290	$self->database_event eq 'update_on' && !$self->fields;
	291
	292	return 1;
	293	}
	294
	295	# ----------------------------------------------------------------------
	296	sub name {
	297
	298	=pod
	299
	300	=head2 name
	301
	302	Get or set the trigger's name.
	303
304	my $name = $trigger->name('foo');
305
306	=cut
307
308	my $self = shift;
309	$self->{'name'} = shift if @_;
310	return $self->{'name'} \|\| '';
311	}
312
313	# ----------------------------------------------------------------------
314	sub order {
315
316	=pod
317
318	=head2 order
319
320	Get or set the trigger's order.
321
322	my $order = $trigger->order(3);
323
324	=cut
325
326	my ( $self, $arg ) = @_;
327
328	if ( defined $arg && $arg =~ /^\d+$/ ) {
329	$self->{'order'} = $arg;
330	}
331
332	return $self->{'order'} \|\| 0;
333	}
334
39ad1787	335	# ----------------------------------------------------------------------
	336	sub schema {
	337
	338	=pod
	339
	340	=head2 schema
	341
	342	Get or set the trigger's schema object.
	343
	344	$trigger->schema( $schema );
	345	my $schema = $trigger->schema;
	346
	347	=cut
	348
	349	my $self = shift;
	350	if ( my $arg = shift ) {
	351	return $self->error('Not a schema object') unless
	352	UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
	353	$self->{'schema'} = $arg;
	354	}
	355
	356	return $self->{'schema'};
	357	}
	358
	359	# ----------------------------------------------------------------------
8742e408	360	sub compare_arrays {
	361
	362	=pod
	363
	364	=head2 compare_arrays
	365
	366	Compare two arrays.
	367
	368	=cut
	369
	370	my ($first, $second) = @_;
	371	no warnings; # silence spurious -w undef complaints
	372
	373	return 0 unless (ref $first eq 'ARRAY' and ref $second eq 'ARRAY' ) ;
	374	return 0 unless @$first == @$second;
	375	my @first = sort @$first;
	376	my @second = sort @$second;
	377	for (my $i = 0; $i < scalar @first; $i++) {
	378	return 0 if @first[$i] ne @second[$i];
	379	}
	380	return 1;
	381	}
	382
	383	# ----------------------------------------------------------------------
abf315bb	384	sub equals {
	385
	386	=pod
	387
	388	=head2 equals
	389
	390	Determines if this trigger is the same as another
	391
	392	my $isIdentical = $trigger1->equals( $trigger2 );
	393
	394	=cut
	395
	396	my $self = shift;
	397	my $other = shift;
6be9534b	398	my $case_insensitive = shift;
abf315bb	399
abf315bb	400	return 0 unless $self->SUPER::equals($other);
6be9534b	401	return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
4598b71c	402	#return 0 unless $self->is_valid eq $other->is_valid;
abf315bb	403	return 0 unless $self->perform_action_when eq $other->perform_action_when;
8742e408	404	return 0 unless compare_arrays($self->database_events,$other->database_events) ;
abf315bb	405	return 0 unless $self->on_table eq $other->on_table;
abf315bb	406	return 0 unless $self->action eq $other->action;
4598b71c	407	return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
abf315bb	408	return 1;
	409	}
	410
	411	# ----------------------------------------------------------------------
39ad1787	412	sub DESTROY {
	413	my $self = shift;
	414	undef $self->{'schema'}; # destroy cyclical reference
	415	}
	416
e2cf647c	417	1;
	418
	419	# ----------------------------------------------------------------------
	420
	421	=pod
	422
	423	=head1 AUTHOR
	424
	425	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
	426
	427	=cut