Profile of SQL/Translator/Schema/Trigger.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:24:06 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Trigger.pm
Statements | Executed 21 statements in 1.02ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 17µs | 22µs | SQL::Translator::Schema::Trigger::::BEGIN@48SQL::Translator::Schema::Trigger::BEGIN@48
1 | 1 | 1 | 12µs | 29µs | SQL::Translator::Schema::Trigger::::BEGIN@369SQL::Translator::Schema::Trigger::BEGIN@369
1 | 1 | 1 | 9µs | 48µs | SQL::Translator::Schema::Trigger::::BEGIN@53SQL::Translator::Schema::Trigger::BEGIN@53
1 | 1 | 1 | 9µs | 75µs | SQL::Translator::Schema::Trigger::::BEGIN@49SQL::Translator::Schema::Trigger::BEGIN@49
1 | 1 | 1 | 8µs | 87µs | SQL::Translator::Schema::Trigger::::BEGIN@51SQL::Translator::Schema::Trigger::BEGIN@51
1 | 1 | 1 | 8µs | 53µs | SQL::Translator::Schema::Trigger::::BEGIN@55SQL::Translator::Schema::Trigger::BEGIN@55
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::DESTROYSQL::Translator::Schema::Trigger::DESTROY
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::actionSQL::Translator::Schema::Trigger::action
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::compare_arraysSQL::Translator::Schema::Trigger::compare_arrays
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::database_eventSQL::Translator::Schema::Trigger::database_event
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::database_eventsSQL::Translator::Schema::Trigger::database_events
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::equalsSQL::Translator::Schema::Trigger::equals
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::fieldsSQL::Translator::Schema::Trigger::fields
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::is_validSQL::Translator::Schema::Trigger::is_valid
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::nameSQL::Translator::Schema::Trigger::name
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::on_tableSQL::Translator::Schema::Trigger::on_table
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::orderSQL::Translator::Schema::Trigger::order
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::perform_action_whenSQL::Translator::Schema::Trigger::perform_action_when
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::schemaSQL::Translator::Schema::Trigger::schema
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Trigger::::tableSQL::Translator::Schema::Trigger::table

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package SQL::Translator::Schema::Trigger;
2 |  |  |  |  |
3 |  |  |  |  | # ----------------------------------------------------------------------
4 |  |  |  |  | # Copyright (C) 2002-2009 SQLFairy Authors
5 |  |  |  |  | #
6 |  |  |  |  | # This program is free software; you can redistribute it and/or
7 |  |  |  |  | # modify it under the terms of the GNU General Public License as
8 |  |  |  |  | # published by the Free Software Foundation; version 2.
9 |  |  |  |  | #
10 |  |  |  |  | # This program is distributed in the hope that it will be useful, but
11 |  |  |  |  | # WITHOUT ANY WARRANTY; without even the implied warranty of
12 |  |  |  |  | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 |  |  |  |  | # General Public License for more details.
14 |  |  |  |  | #
15 |  |  |  |  | # You should have received a copy of the GNU General Public License
16 |  |  |  |  | # along with this program; if not, write to the Free Software
17 |  |  |  |  | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
18 |  |  |  |  | # 02111-1307 USA
19 |  |  |  |  | # -------------------------------------------------------------------
20 |  |  |  |  |
21 |  |  |  |  | =pod
22 |  |  |  |  |
23 |  |  |  |  | =head1 NAME
24 |  |  |  |  |
25 |  |  |  |  | SQL::Translator::Schema::Trigger - SQL::Translator trigger object
26 |  |  |  |  |
27 |  |  |  |  | =head1 SYNOPSIS
28 |  |  |  |  |
29 |  |  |  |  | use SQL::Translator::Schema::Trigger;
30 |  |  |  |  | my $trigger = SQL::Translator::Schema::Trigger->new(
31 |  |  |  |  | name => 'foo',
32 |  |  |  |  | perform_action_when => 'before', # or after
33 |  |  |  |  | database_events => [qw/update insert/], # also update, update_on, delete
34 |  |  |  |  | fields => [], # if event is "update"
35 |  |  |  |  | on_table => 'foo', # table name
36 |  |  |  |  | action => '...', # text of trigger
37 |  |  |  |  | schema => $schema, # Schema object
38 |  |  |  |  | );
39 |  |  |  |  |
40 |  |  |  |  | =head1 DESCRIPTION
41 |  |  |  |  |
42 |  |  |  |  | C<SQL::Translator::Schema::Trigger> is the trigger object.
43 |  |  |  |  |
44 |  |  |  |  | =head1 METHODS
45 |  |  |  |  |
46 |  |  |  |  | =cut
47 |  |  |  |  |
48 | 3 | 26µs | 2 | 27µs | # spent 22µs (17+5) within SQL::Translator::Schema::Trigger::BEGIN@48 which was called: # once (17µs+5µs) by SQL::Translator::Schema::BEGIN@51 at line 48 use strict; # spent 22µs making 1 call to SQL::Translator::Schema::Trigger::BEGIN@48 # spent 5µs making 1 call to strict::import
49 | 3 | 22µs | 2 | 141µs | # spent 75µs (9+66) within SQL::Translator::Schema::Trigger::BEGIN@49 which was called: # once (9µs+66µs) by SQL::Translator::Schema::BEGIN@51 at line 49 use SQL::Translator::Utils 'parse_list_arg'; # spent 75µs making 1 call to SQL::Translator::Schema::Trigger::BEGIN@49 # spent 66µs making 1 call to Exporter::import
50 |  |  |  |  |
51 | 3 | 21µs | 2 | 167µs | # spent 87µs (8+79) within SQL::Translator::Schema::Trigger::BEGIN@51 which was called: # once (8µs+79µs) by SQL::Translator::Schema::BEGIN@51 at line 51 use base 'SQL::Translator::Schema::Object'; # spent 87µs making 1 call to SQL::Translator::Schema::Trigger::BEGIN@51 # spent 79µs making 1 call to base::import
52 |  |  |  |  |
53 | 3 | 23µs | 2 | 88µs | # spent 48µs (9+40) within SQL::Translator::Schema::Trigger::BEGIN@53 which was called: # once (9µs+40µs) by SQL::Translator::Schema::BEGIN@51 at line 53 use Carp; # spent 48µs making 1 call to SQL::Translator::Schema::Trigger::BEGIN@53 # spent 40µs making 1 call to Exporter::import
54 |  |  |  |  |
55 | 3 | 680µs | 2 | 99µs | # spent 53µs (8+45) within SQL::Translator::Schema::Trigger::BEGIN@55 which was called: # once (8µs+45µs) by SQL::Translator::Schema::BEGIN@51 at line 55 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); # spent 53µs making 1 call to SQL::Translator::Schema::Trigger::BEGIN@55 # spent 45µs making 1 call to vars::import
56 |  |  |  |  |
57 | 1 | 600ns |  |  | $VERSION = '1.59';
58 |  |  |  |  |
59 |  |  |  |  | # ----------------------------------------------------------------------
60 |  |  |  |  |
61 | 1 | 4µs | 1 | 53µs | __PACKAGE__->_attributes( qw/ # spent 53µs making 1 call to SQL::Translator::Schema::Object::_attributes
62 |  |  |  |  | name schema perform_action_when database_events database_event
63 |  |  |  |  | fields table on_table action order
64 |  |  |  |  | /);
65 |  |  |  |  |
66 |  |  |  |  | =pod
67 |  |  |  |  |
68 |  |  |  |  | =head2 new
69 |  |  |  |  |
70 |  |  |  |  | Object constructor.
71 |  |  |  |  |
72 |  |  |  |  | my $schema = SQL::Translator::Schema::Trigger->new;
73 |  |  |  |  |
74 |  |  |  |  | =cut
75 |  |  |  |  |
76 |  |  |  |  | # ----------------------------------------------------------------------
77 |  |  |  |  | sub perform_action_when {
78 |  |  |  |  |
79 |  |  |  |  | =pod
80 |  |  |  |  |
81 |  |  |  |  | =head2 perform_action_when
82 |  |  |  |  |
83 |  |  |  |  | Gets or sets whether the event happens "before" or "after" the
84 |  |  |  |  | C<database_event>.
85 |  |  |  |  |
86 |  |  |  |  | $trigger->perform_action_when('after');
87 |  |  |  |  |
88 |  |  |  |  | =cut
89 |  |  |  |  |
90 |  |  |  |  | my $self = shift;
91 |  |  |  |  |
92 |  |  |  |  | if ( my $arg = shift ) {
93 |  |  |  |  | $arg = lc $arg;
94 |  |  |  |  | $arg =~ s/\s+/ /g;
95 |  |  |  |  | if ( $arg =~ m/^(before|after)$/i ) {
96 |  |  |  |  | $self->{'perform_action_when'} = $arg;
97 |  |  |  |  | }
98 |  |  |  |  | else {
99 |  |  |  |  | return
100 |  |  |  |  | $self->error("Invalid argument '$arg' to perform_action_when");
101 |  |  |  |  | }
102 |  |  |  |  | }
103 |  |  |  |  |
104 |  |  |  |  | return $self->{'perform_action_when'};
105 |  |  |  |  | }
106 |  |  |  |  |
107 |  |  |  |  | # ----------------------------------------------------------------------
108 |  |  |  |  | sub database_event {
109 |  |  |  |  |
110 |  |  |  |  | =pod
111 |  |  |  |  |
112 |  |  |  |  | =head2 database_event
113 |  |  |  |  |
114 |  |  |  |  | Obsolete please use database_events!
115 |  |  |  |  |
116 |  |  |  |  | =cut
117 |  |  |  |  |
118 |  |  |  |  | my $self = shift;
119 |  |  |  |  |
120 |  |  |  |  | return $self->database_events( @_ );
121 |  |  |  |  | }
122 |  |  |  |  |
123 |  |  |  |  | # ----------------------------------------------------------------------
124 |  |  |  |  | sub database_events {
125 |  |  |  |  |
126 |  |  |  |  | =pod
127 |  |  |  |  |
128 |  |  |  |  | =head2 database_events
129 |  |  |  |  |
130 |  |  |  |  | Gets or sets the events that triggers the trigger.
131 |  |  |  |  |
132 |  |  |  |  | my $ok = $trigger->database_events('insert');
133 |  |  |  |  |
134 |  |  |  |  | =cut
135 |  |  |  |  |
136 |  |  |  |  | my $self = shift;
137 |  |  |  |  | my @args = ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;
138 |  |  |  |  |
139 |  |  |  |  | if ( @args ) {
140 |  |  |  |  | @args = map { s/\s+/ /g; lc $_ } @args;
141 |  |  |  |  | my %valid = map { $_, 1 } qw[ insert update update_on delete ];
142 |  |  |  |  | my @invalid = grep { !defined $valid{ $_ } } @args;
143 |  |  |  |  |
144 |  |  |  |  | if ( @invalid ) {
145 |  |  |  |  | return $self->error(
146 |  |  |  |  | sprintf("Invalid events '%s' in database_events",
147 |  |  |  |  | join(', ', @invalid)
148 |  |  |  |  | )
149 |  |  |  |  | );
150 |  |  |  |  | }
151 |  |  |  |  |
152 |  |  |  |  | $self->{'database_events'} = [ @args ];
153 |  |  |  |  | }
154 |  |  |  |  |
155 |  |  |  |  | return wantarray
156 |  |  |  |  | ? @{ $self->{'database_events'} || [] }
157 |  |  |  |  | : $self->{'database_events'};
158 |  |  |  |  | }
159 |  |  |  |  |
160 |  |  |  |  | # ----------------------------------------------------------------------
161 |  |  |  |  | sub fields {
162 |  |  |  |  |
163 |  |  |  |  | =pod
164 |  |  |  |  |
165 |  |  |  |  | =head2 fields
166 |  |  |  |  |
167 |  |  |  |  | Gets and set which fields to monitor for C<database_event>.
168 |  |  |  |  |
169 |  |  |  |  | $view->fields('id');
170 |  |  |  |  | $view->fields('id', 'name');
171 |  |  |  |  | $view->fields( 'id, name' );
172 |  |  |  |  | $view->fields( [ 'id', 'name' ] );
173 |  |  |  |  | $view->fields( qw[ id name ] );
174 |  |  |  |  |
175 |  |  |  |  | my @fields = $view->fields;
176 |  |  |  |  |
177 |  |  |  |  | =cut
178 |  |  |  |  |
179 |  |  |  |  | my $self = shift;
180 |  |  |  |  | my $fields = parse_list_arg( @_ );
181 |  |  |  |  |
182 |  |  |  |  | if ( @$fields ) {
183 |  |  |  |  | my ( %unique, @unique );
184 |  |  |  |  | for my $f ( @$fields ) {
185 |  |  |  |  | next if $unique{ $f };
186 |  |  |  |  | $unique{ $f } = 1;
187 |  |  |  |  | push @unique, $f;
188 |  |  |  |  | }
189 |  |  |  |  |
190 |  |  |  |  | $self->{'fields'} = \@unique;
191 |  |  |  |  | }
192 |  |  |  |  |
193 |  |  |  |  | return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
194 |  |  |  |  | }
195 |  |  |  |  |
196 |  |  |  |  | # ----------------------------------------------------------------------
197 |  |  |  |  | sub table {
198 |  |  |  |  |
199 |  |  |  |  | =pod
200 |  |  |  |  |
201 |  |  |  |  | =head2 table
202 |  |  |  |  |
203 |  |  |  |  | Gets or set the table on which the trigger works, as a L<SQL::Translator::Schema::Table> object.
204 |  |  |  |  | $trigger->table($triggered_table);
205 |  |  |  |  |
206 |  |  |  |  | =cut
207 |  |  |  |  |
208 |  |  |  |  | my ($self, $arg) = @_;
209 |  |  |  |  | if ( @_ == 2 ) {
210 |  |  |  |  | $self->error("Table attribute of a ".__PACKAGE__.
211 |  |  |  |  | " must be a SQL::Translator::Schema::Table")
212 |  |  |  |  | unless ref $arg and $arg->isa('SQL::Translator::Schema::Table');
213 |  |  |  |  | $self->{table} = $arg;
214 |  |  |  |  | }
215 |  |  |  |  | return $self->{table};
216 |  |  |  |  | }
217 |  |  |  |  |
218 |  |  |  |  | # ----------------------------------------------------------------------
219 |  |  |  |  | sub on_table {
220 |  |  |  |  |
221 |  |  |  |  | =pod
222 |  |  |  |  |
223 |  |  |  |  | =head2 on_table
224 |  |  |  |  |
225 |  |  |  |  | Gets or set the table name on which the trigger works, as a string.
226 |  |  |  |  | $trigger->on_table('foo');
227 |  |  |  |  |
228 |  |  |  |  | =cut
229 |  |  |  |  |
230 |  |  |  |  | my ($self, $arg) = @_;
231 |  |  |  |  | if ( @_ == 2 ) {
232 |  |  |  |  | my $table = $self->schema->get_table($arg);
233 |  |  |  |  | die "Table named $arg doesn't exist"
234 |  |  |  |  | if !$table;
235 |  |  |  |  | $self->table($table);
236 |  |  |  |  | }
237 |  |  |  |  | return $self->table->name;
238 |  |  |  |  | }
239 |  |  |  |  |
240 |  |  |  |  | # ----------------------------------------------------------------------
241 |  |  |  |  | sub action {
242 |  |  |  |  |
243 |  |  |  |  | =pod
244 |  |  |  |  |
245 |  |  |  |  | =head2 action
246 |  |  |  |  |
247 |  |  |  |  | Gets or set the action of the trigger.
248 |  |  |  |  |
249 |  |  |  |  | $trigger->action(
250 |  |  |  |  | q[
251 |  |  |  |  | BEGIN
252 |  |  |  |  | select ...;
253 |  |  |  |  | update ...;
254 |  |  |  |  | END
255 |  |  |  |  | ]
256 |  |  |  |  | );
257 |  |  |  |  |
258 |  |  |  |  | =cut
259 |  |  |  |  |
260 |  |  |  |  | my $self = shift;
261 |  |  |  |  | my $arg = shift || '';
262 |  |  |  |  | $self->{'action'} = $arg if $arg;
263 |  |  |  |  | return $self->{'action'};
264 |  |  |  |  | }
265 |  |  |  |  |
266 |  |  |  |  | # ----------------------------------------------------------------------
267 |  |  |  |  | sub is_valid {
268 |  |  |  |  |
269 |  |  |  |  | =pod
270 |  |  |  |  |
271 |  |  |  |  | =head2 is_valid
272 |  |  |  |  |
273 |  |  |  |  | Determine whether the trigger is valid or not.
274 |  |  |  |  |
275 |  |  |  |  | my $ok = $trigger->is_valid;
276 |  |  |  |  |
277 |  |  |  |  | =cut
278 |  |  |  |  |
279 |  |  |  |  | my $self = shift;
280 |  |  |  |  |
281 |  |  |  |  | for my $attr (
282 |  |  |  |  | qw[ name perform_action_when database_events on_table action ]
283 |  |  |  |  | ) {
284 |  |  |  |  | return $self->error("Invalid: missing '$attr'") unless $self->$attr();
285 |  |  |  |  | }
286 |  |  |  |  |
287 |  |  |  |  | return $self->error("Missing fields for UPDATE ON") if
288 |  |  |  |  | $self->database_event eq 'update_on' && !$self->fields;
289 |  |  |  |  |
290 |  |  |  |  | return 1;
291 |  |  |  |  | }
292 |  |  |  |  |
293 |  |  |  |  | # ----------------------------------------------------------------------
294 |  |  |  |  | sub name {
295 |  |  |  |  |
296 |  |  |  |  | =pod
297 |  |  |  |  |
298 |  |  |  |  | =head2 name
299 |  |  |  |  |
300 |  |  |  |  | Get or set the trigger's name.
301 |  |  |  |  |
302 |  |  |  |  | my $name = $trigger->name('foo');
303 |  |  |  |  |
304 |  |  |  |  | =cut
305 |  |  |  |  |
306 |  |  |  |  | my $self = shift;
307 |  |  |  |  | $self->{'name'} = shift if @_;
308 |  |  |  |  | return $self->{'name'} || '';
309 |  |  |  |  | }
310 |  |  |  |  |
311 |  |  |  |  | # ----------------------------------------------------------------------
312 |  |  |  |  | sub order {
313 |  |  |  |  |
314 |  |  |  |  | =pod
315 |  |  |  |  |
316 |  |  |  |  | =head2 order
317 |  |  |  |  |
318 |  |  |  |  | Get or set the trigger's order.
319 |  |  |  |  |
320 |  |  |  |  | my $order = $trigger->order(3);
321 |  |  |  |  |
322 |  |  |  |  | =cut
323 |  |  |  |  |
324 |  |  |  |  | my ( $self, $arg ) = @_;
325 |  |  |  |  |
326 |  |  |  |  | if ( defined $arg && $arg =~ /^\d+$/ ) {
327 |  |  |  |  | $self->{'order'} = $arg;
328 |  |  |  |  | }
329 |  |  |  |  |
330 |  |  |  |  | return $self->{'order'} || 0;
331 |  |  |  |  | }
332 |  |  |  |  |
333 |  |  |  |  | # ----------------------------------------------------------------------
334 |  |  |  |  | sub schema {
335 |  |  |  |  |
336 |  |  |  |  | =pod
337 |  |  |  |  |
338 |  |  |  |  | =head2 schema
339 |  |  |  |  |
340 |  |  |  |  | Get or set the trigger's schema object.
341 |  |  |  |  |
342 |  |  |  |  | $trigger->schema( $schema );
343 |  |  |  |  | my $schema = $trigger->schema;
344 |  |  |  |  |
345 |  |  |  |  | =cut
346 |  |  |  |  |
347 |  |  |  |  | my $self = shift;
348 |  |  |  |  | if ( my $arg = shift ) {
349 |  |  |  |  | return $self->error('Not a schema object') unless
350 |  |  |  |  | UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
351 |  |  |  |  | $self->{'schema'} = $arg;
352 |  |  |  |  | }
353 |  |  |  |  |
354 |  |  |  |  | return $self->{'schema'};
355 |  |  |  |  | }
356 |  |  |  |  |
357 |  |  |  |  | # ----------------------------------------------------------------------
358 |  |  |  |  | sub compare_arrays {
359 |  |  |  |  |
360 |  |  |  |  | =pod
361 |  |  |  |  |
362 |  |  |  |  | =head2 compare_arrays
363 |  |  |  |  |
364 |  |  |  |  | Compare two arrays.
365 |  |  |  |  |
366 |  |  |  |  | =cut
367 |  |  |  |  |
368 |  |  |  |  | my ($first, $second) = @_;
369 | 3 | 237µs | 2 | 46µs | # spent 29µs (12+17) within SQL::Translator::Schema::Trigger::BEGIN@369 which was called: # once (12µs+17µs) by SQL::Translator::Schema::BEGIN@51 at line 369 no warnings; # silence spurious -w undef complaints # spent 29µs making 1 call to SQL::Translator::Schema::Trigger::BEGIN@369 # spent 17µs making 1 call to warnings::unimport
370 |  |  |  |  |
371 |  |  |  |  | return 0 unless (ref $first eq 'ARRAY' and ref $second eq 'ARRAY' ) ;
372 |  |  |  |  |
373 |  |  |  |  | return 0 unless @$first == @$second;
374 |  |  |  |  |
375 |  |  |  |  | my @first = sort @$first;
376 |  |  |  |  |
377 |  |  |  |  | my @second = sort @$second;
378 |  |  |  |  |
379 |  |  |  |  | for (my $i = 0; $i < scalar @first; $i++) {
380 |  |  |  |  | return 0 if @first[$i] ne @second[$i];
381 |  |  |  |  | }
382 |  |  |  |  |
383 |  |  |  |  | return 1;
384 |  |  |  |  | }
385 |  |  |  |  |
386 |  |  |  |  | # ----------------------------------------------------------------------
387 |  |  |  |  | sub equals {
388 |  |  |  |  |
389 |  |  |  |  | =pod
390 |  |  |  |  |
391 |  |  |  |  | =head2 equals
392 |  |  |  |  |
393 |  |  |  |  | Determines if this trigger is the same as another
394 |  |  |  |  |
395 |  |  |  |  | my $is_identical = $trigger1->equals( $trigger2 );
396 |  |  |  |  |
397 |  |  |  |  | =cut
398 |  |  |  |  |
399 |  |  |  |  | my $self = shift;
400 |  |  |  |  | my $other = shift;
401 |  |  |  |  | my $case_insensitive = shift;
402 |  |  |  |  |
403 |  |  |  |  | return 0 unless $self->SUPER::equals($other);
404 |  |  |  |  |
405 |  |  |  |  | my %names;
406 |  |  |  |  | for my $name ( $self->name, $other->name ) {
407 |  |  |  |  | $name = lc $name if $case_insensitive;
408 |  |  |  |  | $names{ $name }++;
409 |  |  |  |  | }
410 |  |  |  |  |
411 |  |  |  |  | if ( keys %names > 1 ) {
412 |  |  |  |  | return $self->error('Names not equal');
413 |  |  |  |  | }
414 |  |  |  |  |
415 |  |  |  |  | if ( !$self->perform_action_when eq $other->perform_action_when ) {
416 |  |  |  |  | return $self->error('perform_action_when differs');
417 |  |  |  |  | }
418 |  |  |  |  |
419 |  |  |  |  | if (
420 |  |  |  |  | !compare_arrays( [$self->database_events], [$other->database_events] )
421 |  |  |  |  | ) {
422 |  |  |  |  | return $self->error('database_events differ');
423 |  |  |  |  | }
424 |  |  |  |  |
425 |  |  |  |  | if ( $self->on_table ne $other->on_table ) {
426 |  |  |  |  | return $self->error('on_table differs');
427 |  |  |  |  | }
428 |  |  |  |  |
429 |  |  |  |  | if ( $self->action ne $other->action ) {
430 |  |  |  |  | return $self->error('action differs');
431 |  |  |  |  | }
432 |  |  |  |  |
433 |  |  |  |  | if (
434 |  |  |  |  | !$self->_compare_objects( scalar $self->extra, scalar $other->extra )
435 |  |  |  |  | ) {
436 |  |  |  |  | return $self->error('extras differ');
437 |  |  |  |  | }
438 |  |  |  |  |
439 |  |  |  |  | return 1;
440 |  |  |  |  | }
441 |  |  |  |  |
442 |  |  |  |  | # ----------------------------------------------------------------------
443 |  |  |  |  | sub DESTROY {
444 |  |  |  |  | my $self = shift;
445 |  |  |  |  | undef $self->{'schema'}; # destroy cyclical reference
446 |  |  |  |  | }
447 |  |  |  |  |
448 | 1 | 4µs |  |  | 1;
449 |  |  |  |  |
450 |  |  |  |  | # ----------------------------------------------------------------------
451 |  |  |  |  |
452 |  |  |  |  | =pod
453 |  |  |  |  |
454 |  |  |  |  | =head1 AUTHORS
455 |  |  |  |  |
456 |  |  |  |  | Anonymous,
457 |  |  |  |  | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
458 |  |  |  |  |
459 |  |  |  |  | =cut