← 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:23:18 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Constraint.pm
StatementsExecuted 8559 statements in 10.5ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
433645.15ms11.0msSQL::Translator::Schema::Constraint::::fieldsSQL::Translator::Schema::Constraint::fields
660531.31ms1.40msSQL::Translator::Schema::Constraint::::typeSQL::Translator::Schema::Constraint::type
530331.15ms1.53msSQL::Translator::Schema::Constraint::::tableSQL::Translator::Schema::Constraint::table
6711756µs7.55msSQL::Translator::Schema::Constraint::::initSQL::Translator::Schema::Constraint::init
2911201µs438µsSQL::Translator::Schema::Constraint::::reference_fieldsSQL::Translator::Schema::Constraint::reference_fields
3522115µs115µsSQL::Translator::Schema::Constraint::::nameSQL::Translator::Schema::Constraint::name
671191µs91µsSQL::Translator::Schema::Constraint::::CORE:substSQL::Translator::Schema::Constraint::CORE:subst (opcode)
291177µs77µsSQL::Translator::Schema::Constraint::::reference_tableSQL::Translator::Schema::Constraint::reference_table
291175µs75µsSQL::Translator::Schema::Constraint::::on_updateSQL::Translator::Schema::Constraint::on_update
291173µs73µsSQL::Translator::Schema::Constraint::::on_deleteSQL::Translator::Schema::Constraint::on_delete
11112µs14µsSQL::Translator::Schema::Constraint::::BEGIN@44SQL::Translator::Schema::Constraint::BEGIN@44
1117µs74µsSQL::Translator::Schema::Constraint::::BEGIN@48SQL::Translator::Schema::Constraint::BEGIN@48
1117µs60µsSQL::Translator::Schema::Constraint::::BEGIN@45SQL::Translator::Schema::Constraint::BEGIN@45
1117µs24µsSQL::Translator::Schema::Constraint::::BEGIN@46SQL::Translator::Schema::Constraint::BEGIN@46
1116µs45µsSQL::Translator::Schema::Constraint::::BEGIN@50SQL::Translator::Schema::Constraint::BEGIN@50
0000s0sSQL::Translator::Schema::Constraint::::DESTROYSQL::Translator::Schema::Constraint::DESTROY
0000s0sSQL::Translator::Schema::Constraint::::deferrableSQL::Translator::Schema::Constraint::deferrable
0000s0sSQL::Translator::Schema::Constraint::::equalsSQL::Translator::Schema::Constraint::equals
0000s0sSQL::Translator::Schema::Constraint::::expressionSQL::Translator::Schema::Constraint::expression
0000s0sSQL::Translator::Schema::Constraint::::field_namesSQL::Translator::Schema::Constraint::field_names
0000s0sSQL::Translator::Schema::Constraint::::is_validSQL::Translator::Schema::Constraint::is_valid
0000s0sSQL::Translator::Schema::Constraint::::match_typeSQL::Translator::Schema::Constraint::match_type
0000s0sSQL::Translator::Schema::Constraint::::optionsSQL::Translator::Schema::Constraint::options
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package SQL::Translator::Schema::Constraint;
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
25SQL::Translator::Schema::Constraint - SQL::Translator constraint object
26
27=head1 SYNOPSIS
28
29 use SQL::Translator::Schema::Constraint;
30 my $constraint = SQL::Translator::Schema::Constraint->new(
31 name => 'foo',
32 fields => [ id ],
33 type => PRIMARY_KEY,
34 );
35
36=head1 DESCRIPTION
37
38C<SQL::Translator::Schema::Constraint> is the constraint object.
39
40=head1 METHODS
41
42=cut
43
44317µs216µs
# spent 14µs (12+2) within SQL::Translator::Schema::Constraint::BEGIN@44 which was called: # once (12µs+2µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 44
use strict;
# spent 14µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@44 # spent 2µs making 1 call to strict::import
45319µs2114µs
# spent 60µs (7+53) within SQL::Translator::Schema::Constraint::BEGIN@45 which was called: # once (7µs+53µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 45
use SQL::Translator::Schema::Constants;
# spent 60µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@45 # spent 53µs making 1 call to Exporter::import
46320µs242µs
# spent 24µs (7+18) within SQL::Translator::Schema::Constraint::BEGIN@46 which was called: # once (7µs+18µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 46
use SQL::Translator::Utils 'parse_list_arg';
# spent 24µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@46 # spent 18µs making 1 call to Exporter::import
47
48322µs2141µs
# spent 74µs (7+67) within SQL::Translator::Schema::Constraint::BEGIN@48 which was called: # once (7µs+67µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 48
use base 'SQL::Translator::Schema::Object';
# spent 74µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@48 # spent 67µs making 1 call to base::import
49
5031.39ms284µs
# spent 45µs (6+39) within SQL::Translator::Schema::Constraint::BEGIN@50 which was called: # once (6µs+39µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 50
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
# spent 45µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@50 # spent 39µs making 1 call to vars::import
51
521600ns$VERSION = '1.59';
53
5415µsmy %VALID_CONSTRAINT_TYPE = (
55 PRIMARY_KEY, 1,
56 UNIQUE, 1,
57 CHECK_C, 1,
58 FOREIGN_KEY, 1,
59 NOT_NULL, 1,
60);
61
62# ----------------------------------------------------------------------
63
6417µs153µs__PACKAGE__->_attributes( qw/
# spent 53µs making 1 call to SQL::Translator::Schema::Object::_attributes
65 table name type fields reference_fields reference_table
66 match_type on_delete on_update expression deferrable
67/);
68
69# Override to remove empty arrays from args.
70# t/14postgres-parser breaks without this.
71
# spent 7.55ms (756µs+6.79) within SQL::Translator::Schema::Constraint::init which was called 67 times, avg 113µs/call: # 67 times (756µs+6.79ms) by Class::Base::new at line 59 of Class/Base.pm, avg 113µs/call
sub init {
72
73=pod
74
75=head2 new
76
77Object constructor.
78
79 my $schema = SQL::Translator::Schema::Constraint->new(
80 table => $table, # table to which it belongs
81 type => 'foreign_key', # type of table constraint
82 name => 'fk_phone_id', # name of the constraint
83 fields => 'phone_id', # field in the referring table
84 reference_fields => 'phone_id', # referenced field
85 reference_table => 'phone', # referenced table
86 match_type => 'full', # how to match
87 on_delete => 'cascade', # what to do on deletes
88 on_update => '', # what to do on updates
89 );
90
91=cut
92
93201529µs my $self = shift;
94349214µs foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
95676.79ms $self->SUPER::init(@_);
# spent 6.79ms making 67 calls to SQL::Translator::Schema::Object::init, avg 101µs/call
96}
97
98# ----------------------------------------------------------------------
99sub deferrable {
100
101=pod
102
103=head2 deferrable
104
105Get or set whether the constraint is deferrable. If not defined,
106then returns "1." The argument is evaluated by Perl for True or
107False, so the following are eqivalent:
108
109 $deferrable = $field->deferrable(0);
110 $deferrable = $field->deferrable('');
111 $deferrable = $field->deferrable('0');
112
113=cut
114
115 my ( $self, $arg ) = @_;
116
117 if ( defined $arg ) {
118 $self->{'deferrable'} = $arg ? 1 : 0;
119 }
120
121 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
122}
123
124# ----------------------------------------------------------------------
125sub expression {
126
127=pod
128
129=head2 expression
130
131Gets and set the expression used in a CHECK constraint.
132
133 my $expression = $constraint->expression('...');
134
135=cut
136
137 my $self = shift;
138
139 if ( my $arg = shift ) {
140 # check arg here?
141 $self->{'expression'} = $arg;
142 }
143
144 return $self->{'expression'} || '';
145}
146
147# ----------------------------------------------------------------------
148sub is_valid {
149
150=pod
151
152=head2 is_valid
153
154Determine whether the constraint is valid or not.
155
156 my $ok = $constraint->is_valid;
157
158=cut
159
160 my $self = shift;
161 my $type = $self->type or return $self->error('No type');
162 my $table = $self->table or return $self->error('No table');
163 my @fields = $self->fields or return $self->error('No fields');
164 my $table_name = $table->name or return $self->error('No table name');
165
166 for my $f ( @fields ) {
167 next if $table->get_field( $f );
168 return $self->error(
169 "Constraint references non-existent field '$f' ",
170 "in table '$table_name'"
171 );
172 }
173
174 my $schema = $table->schema or return $self->error(
175 'Table ', $table->name, ' has no schema object'
176 );
177
178 if ( $type eq FOREIGN_KEY ) {
179 return $self->error('Only one field allowed for foreign key')
180 if scalar @fields > 1;
181
182 my $ref_table_name = $self->reference_table or
183 return $self->error('No reference table');
184
185 my $ref_table = $schema->get_table( $ref_table_name ) or
186 return $self->error("No table named '$ref_table_name' in schema");
187
188 my @ref_fields = $self->reference_fields or return;
189
190 return $self->error('Only one field allowed for foreign key reference')
191 if scalar @ref_fields > 1;
192
193 for my $ref_field ( @ref_fields ) {
194 next if $ref_table->get_field( $ref_field );
195 return $self->error(
196 "Constraint from field(s) ",
197 join(', ', map {qq['$table_name.$_']} @fields),
198 " to non-existent field '$ref_table_name.$ref_field'"
199 );
200 }
201 }
202 elsif ( $type eq CHECK_C ) {
203 return $self->error('No expression for CHECK') unless
204 $self->expression;
205 }
206
207 return 1;
208}
209
210# ----------------------------------------------------------------------
211
# spent 11.0ms (5.15+5.87) within SQL::Translator::Schema::Constraint::fields which was called 433 times, avg 25µs/call: # 240 times (2.54ms+2.89ms) by SQL::Translator::Producer::SQLite::create_field at line 298 of SQL/Translator/Producer/SQLite.pm, avg 23µs/call # 67 times (1.20ms+1.30ms) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 37µs/call # 53 times (546µs+676µs) by SQL::Translator::Schema::Field::is_primary_key at line 385 of SQL/Translator/Schema/Field.pm, avg 23µs/call # 35 times (429µs+506µs) by SQL::Translator::Producer::SQLite::create_table at line 206 of SQL/Translator/Producer/SQLite.pm, avg 27µs/call # 35 times (401µs+454µs) by SQL::Translator::Schema::Table::add_constraint at line 136 of SQL/Translator/Schema/Table.pm, avg 24µs/call # 3 times (32µs+38µs) by SQL::Translator::Producer::SQLite::create_constraint at line 361 of SQL/Translator/Producer/SQLite.pm, avg 23µs/call
sub fields {
212
213=pod
214
215=head2 fields
216
217Gets and set the fields the constraint is on. Accepts a string, list or
218arrayref; returns an array or array reference. Will unique the field
219names and keep them in order by the first occurrence of a field name.
220
221The fields are returned as Field objects if they exist or as plain
222names if not. (If you just want the names and want to avoid the Field's overload
223magic use L<field_names>).
224
225Returns undef or an empty list if the constraint has no fields set.
226
227 $constraint->fields('id');
228 $constraint->fields('id', 'name');
229 $constraint->fields( 'id, name' );
230 $constraint->fields( [ 'id', 'name' ] );
231 $constraint->fields( qw[ id name ] );
232
233 my @fields = $constraint->fields;
234
235=cut
236
2371732806µs my $self = shift;
2384332.04ms my $fields = parse_list_arg( @_ );
# spent 2.04ms making 433 calls to SQL::Translator::Utils::parse_list_arg, avg 5µs/call
239
240201155µs if ( @$fields ) {
241 my ( %unique, @unique );
242 for my $f ( @$fields ) {
243213137µs next if $unique{ $f };
244 $unique{ $f } = 1;
245 push @unique, $f;
246 }
247
248 $self->{'fields'} = \@unique;
249 }
250
2518661.47ms if ( @{ $self->{'fields'} || [] } ) {
252 # We have to return fields that don't exist on the table as names in
253 # case those fields havn't been created yet.
2541217µs13803.83ms my @ret = map {
# spent 2.03ms making 460 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:58], avg 4µs/call # spent 1.11ms making 460 calls to SQL::Translator::Schema::Table::get_field, avg 2µs/call # spent 687µs making 460 calls to SQL::Translator::Schema::Constraint::table, avg 1µs/call
2554601.29ms $self->table->get_field($_) || $_ } @{ $self->{'fields'} };
256 return wantarray ? @ret : \@ret;
257 }
258 else {
259 return wantarray ? () : undef;
260 }
261}
262
263# ----------------------------------------------------------------------
264sub field_names {
265
266=head2 field_names
267
268Read-only method to return a list or array ref of the field names. Returns undef
269or an empty list if the constraint has no fields set. Useful if you want to
270avoid the overload magic of the Field objects returned by the fields method.
271
272 my @names = $constraint->field_names;
273
274=cut
275
276 my $self = shift;
277 return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || '');
278}
279
280# ----------------------------------------------------------------------
281sub match_type {
282
283=pod
284
285=head2 match_type
286
287Get or set the constraint's match_type. Only valid values are "full"
288"partial" and "simple"
289
290 my $match_type = $constraint->match_type('FULL');
291
292=cut
293
294 my ( $self, $arg ) = @_;
295
296 if ( $arg ) {
297 $arg = lc $arg;
298 return $self->error("Invalid match type: $arg")
299 unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple';
300 $self->{'match_type'} = $arg;
301 }
302
303 return $self->{'match_type'} || '';
304}
305
306# ----------------------------------------------------------------------
307
# spent 115µs within SQL::Translator::Schema::Constraint::name which was called 35 times, avg 3µs/call: # 32 times (105µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call # 3 times (10µs+0s) by SQL::Translator::Producer::SQLite::create_constraint at line 359 of SQL/Translator/Producer/SQLite.pm, avg 3µs/call
sub name {
308
309=pod
310
311=head2 name
312
313Get or set the constraint's name.
314
315 my $name = $constraint->name('foo');
316
317=cut
318
319140149µs my $self = shift;
320 my $arg = shift || '';
321 $self->{'name'} = $arg if $arg;
322 return $self->{'name'} || '';
323}
324
325# ----------------------------------------------------------------------
326sub options {
327
328=pod
329
330=head2 options
331
332Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
333Returns an array or array reference.
334
335 $constraint->options('NORELY');
336 my @options = $constraint->options;
337
338=cut
339
340 my $self = shift;
341 my $options = parse_list_arg( @_ );
342
343 push @{ $self->{'options'} }, @$options;
344
345 if ( ref $self->{'options'} ) {
346 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
347 }
348 else {
349 return wantarray ? () : [];
350 }
351}
352
353
354# ----------------------------------------------------------------------
355
# spent 73µs within SQL::Translator::Schema::Constraint::on_delete which was called 29 times, avg 3µs/call: # 29 times (73µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call
sub on_delete {
356
357=pod
358
359=head2 on_delete
360
361Get or set the constraint's "on delete" action.
362
363 my $action = $constraint->on_delete('cascade');
364
365=cut
366
36787100µs my $self = shift;
368
369 if ( my $arg = shift ) {
370 # validate $arg?
371 $self->{'on_delete'} = $arg;
372 }
373
374 return $self->{'on_delete'} || '';
375}
376
377# ----------------------------------------------------------------------
378
# spent 75µs within SQL::Translator::Schema::Constraint::on_update which was called 29 times, avg 3µs/call: # 29 times (75µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call
sub on_update {
379
380=pod
381
382=head2 on_update
383
384Get or set the constraint's "on update" action.
385
386 my $action = $constraint->on_update('no action');
387
388=cut
389
39087107µs my $self = shift;
391
392 if ( my $arg = shift ) {
393 # validate $arg?
394 $self->{'on_update'} = $arg;
395 }
396
397 return $self->{'on_update'} || '';
398}
399
400# ----------------------------------------------------------------------
401
# spent 438µs (201+237) within SQL::Translator::Schema::Constraint::reference_fields which was called 29 times, avg 15µs/call: # 29 times (201µs+237µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 15µs/call
sub reference_fields {
402
403=pod
404
405=head2 reference_fields
406
407Gets and set the fields in the referred table. Accepts a string, list or
408arrayref; returns an array or array reference.
409
410 $constraint->reference_fields('id');
411 $constraint->reference_fields('id', 'name');
412 $constraint->reference_fields( 'id, name' );
413 $constraint->reference_fields( [ 'id', 'name' ] );
414 $constraint->reference_fields( qw[ id name ] );
415
416 my @reference_fields = $constraint->reference_fields;
417
418=cut
419
420145185µs my $self = shift;
42129237µs my $fields = parse_list_arg( @_ );
# spent 237µs making 29 calls to SQL::Translator::Utils::parse_list_arg, avg 8µs/call
422
423 if ( @$fields ) {
424 $self->{'reference_fields'} = $fields;
425 }
426
427 # Nothing set so try and derive it from the other constraint data
428 unless ( ref $self->{'reference_fields'} ) {
429 my $table = $self->table or return $self->error('No table');
430 my $schema = $table->schema or return $self->error('No schema');
431 if ( my $ref_table_name = $self->reference_table ) {
432 my $ref_table = $schema->get_table( $ref_table_name ) or
433 return $self->error("Can't find table '$ref_table_name'");
434
435 if ( my $constraint = $ref_table->primary_key ) {
436 $self->{'reference_fields'} = [ $constraint->fields ];
437 }
438 else {
439 $self->error(
440 'No reference fields defined and cannot find primary key in ',
441 "reference table '$ref_table_name'"
442 );
443 }
444 }
445 # No ref table so we are not that sort of constraint, hence no ref
446 # fields. So we let the return below return an empty list.
447 }
448
449 if ( ref $self->{'reference_fields'} ) {
450 return wantarray
451 ? @{ $self->{'reference_fields'} }
452 : $self->{'reference_fields'};
453 }
454 else {
455 return wantarray ? () : [];
456 }
457}
458
459# ----------------------------------------------------------------------
460
# spent 77µs within SQL::Translator::Schema::Constraint::reference_table which was called 29 times, avg 3µs/call: # 29 times (77µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call
sub reference_table {
461
462=pod
463
464=head2 reference_table
465
466Get or set the table referred to by the constraint.
467
468 my $reference_table = $constraint->reference_table('foo');
469
470=cut
471
47287108µs my $self = shift;
473 $self->{'reference_table'} = shift if @_;
474 return $self->{'reference_table'} || '';
475}
476
477# ----------------------------------------------------------------------
478
# spent 1.53ms (1.15+383µs) within SQL::Translator::Schema::Constraint::table which was called 530 times, avg 3µs/call: # 460 times (687µs+0s) by SQL::Translator::Schema::Constraint::fields at line 254, avg 1µs/call # 67 times (460µs+383µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 13µs/call # 3 times (4µs+0s) by SQL::Translator::Producer::SQLite::create_constraint at line 362 of SQL/Translator/Producer/SQLite.pm, avg 1µs/call
sub table {
479
480=pod
481
482=head2 table
483
484Get or set the constraint's table object.
485
486 my $table = $field->table;
487
488=cut
489
49015901.31ms my $self = shift;
491134238µs67327µs if ( my $arg = shift ) {
# spent 327µs making 67 calls to SQL::Translator::Schema::Table::__ANON__[SQL/Translator/Schema/Table.pm:59], avg 5µs/call
4926755µs return $self->error('Not a table object') unless
# spent 55µs making 67 calls to UNIVERSAL::isa, avg 827ns/call
493 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
494 $self->{'table'} = $arg;
495 }
496
497 return $self->{'table'};
498}
499
500# ----------------------------------------------------------------------
501
# spent 1.40ms (1.31+91µs) within SQL::Translator::Schema::Constraint::type which was called 660 times, avg 2µs/call: # 360 times (564µs+0s) by SQL::Translator::Schema::Table::primary_key at line 841 of SQL/Translator/Schema/Table.pm, avg 2µs/call # 99 times (144µs+0s) by SQL::Translator::Schema::Table::add_constraint at line 136 of SQL/Translator/Schema/Table.pm, avg 1µs/call # 67 times (413µs+91µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 8µs/call # 67 times (103µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 237 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call # 67 times (88µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 240 of SQL/Translator/Producer/SQLite.pm, avg 1µs/call
sub type {
502
503=pod
504
505=head2 type
506
507Get or set the constraint's type.
508
509 my $type = $constraint->type( PRIMARY_KEY );
510
511=cut
512
51319801.65ms my ( $self, $type ) = @_;
514
515268351µs if ( $type ) {
516 $type = uc $type;
5176791µs $type =~ s/_/ /g;
# spent 91µs making 67 calls to SQL::Translator::Schema::Constraint::CORE:subst, avg 1µs/call
518 return $self->error("Invalid constraint type: $type")
519 unless $VALID_CONSTRAINT_TYPE{ $type };
520 $self->{'type'} = $type;
521 }
522
523 return $self->{'type'} || '';
524}
525
526# ----------------------------------------------------------------------
527sub equals {
528
529=pod
530
531=head2 equals
532
533Determines if this constraint is the same as another
534
535 my $isIdentical = $constraint1->equals( $constraint2 );
536
537=cut
538
539 my $self = shift;
540 my $other = shift;
541 my $case_insensitive = shift;
542 my $ignore_constraint_names = shift;
543
544 return 0 unless $self->SUPER::equals($other);
545 return 0 unless $self->type eq $other->type;
546 unless ($ignore_constraint_names) {
547 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
548 }
549 return 0 unless $self->deferrable eq $other->deferrable;
550 #return 0 unless $self->is_valid eq $other->is_valid;
551 return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
552 : $self->table->name eq $other->table->name;
553 return 0 unless $self->expression eq $other->expression;
554
555 # Check fields, regardless of order
556 my %otherFields = (); # create a hash of the other fields
557 foreach my $otherField ($other->fields) {
558 $otherField = uc($otherField) if $case_insensitive;
559 $otherFields{$otherField} = 1;
560 }
561 foreach my $selfField ($self->fields) { # check for self fields in hash
562 $selfField = uc($selfField) if $case_insensitive;
563 return 0 unless $otherFields{$selfField};
564 delete $otherFields{$selfField};
565 }
566 # Check all other fields were accounted for
567 return 0 unless keys %otherFields == 0;
568
569 # Check reference fields, regardless of order
570 my %otherRefFields = (); # create a hash of the other reference fields
571 foreach my $otherRefField ($other->reference_fields) {
572 $otherRefField = uc($otherRefField) if $case_insensitive;
573 $otherRefFields{$otherRefField} = 1;
574 }
575 foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
576 $selfRefField = uc($selfRefField) if $case_insensitive;
577 return 0 unless $otherRefFields{$selfRefField};
578 delete $otherRefFields{$selfRefField};
579 }
580 # Check all other reference fields were accounted for
581 return 0 unless keys %otherRefFields == 0;
582
583 return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
584 return 0 unless $self->match_type eq $other->match_type;
585 return 0 unless $self->on_delete eq $other->on_delete;
586 return 0 unless $self->on_update eq $other->on_update;
587 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
588 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
589 return 1;
590}
591
592# ----------------------------------------------------------------------
593sub DESTROY {
594 my $self = shift;
595 undef $self->{'table'}; # destroy cyclical reference
596}
597
59815µs1;
599
600# ----------------------------------------------------------------------
601
602=pod
603
604=head1 AUTHOR
605
606Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
607
608=cut
 
# spent 91µs within SQL::Translator::Schema::Constraint::CORE:subst which was called 67 times, avg 1µs/call: # 67 times (91µs+0s) by SQL::Translator::Schema::Constraint::type at line 517, avg 1µs/call
sub SQL::Translator::Schema::Constraint::CORE:subst; # opcode