[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 Carp;

use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);

$VERSION = '1.99';

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

__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);

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