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

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

# ----------------------------------------------------------------------
# $Id$
# ----------------------------------------------------------------------
# Copyright (C) 2002-4 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($VERSION $TABLE_COUNT $VIEW_COUNT);

$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;

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

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