← 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/Table.pm
StatementsExecuted 21652 statements in 27.9ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
240114.66ms45.2msSQL::Translator::Schema::Table::::add_fieldSQL::Translator::Schema::Table::add_field
578544.53ms16.8msSQL::Translator::Schema::Table::::primary_keySQL::Translator::Schema::Table::primary_key (recurses: max depth 1, inclusive time 636µs)
1124963.52ms5.12msSQL::Translator::Schema::Table::::__ANON__[:59]SQL::Translator::Schema::Table::__ANON__[:59]
778432.61ms3.87msSQL::Translator::Schema::Table::::get_fieldSQL::Translator::Schema::Table::get_field
853432.22ms3.50msSQL::Translator::Schema::Table::::get_constraintsSQL::Translator::Schema::Table::get_constraints
1263642.00ms2.08msSQL::Translator::Schema::Table::::nameSQL::Translator::Schema::Table::name
67321.79ms13.4msSQL::Translator::Schema::Table::::add_constraintSQL::Translator::Schema::Table::add_constraint
1111.74ms2.79msSQL::Translator::Schema::Table::::BEGIN@44SQL::Translator::Schema::Table::BEGIN@44
1111.54ms1.81msSQL::Translator::Schema::Table::::BEGIN@43SQL::Translator::Schema::Table::BEGIN@43
35111.00ms1.63msSQL::Translator::Schema::Table::::get_fieldsSQL::Translator::Schema::Table::get_fields
111752µs1.07msSQL::Translator::Schema::Table::::BEGIN@45SQL::Translator::Schema::Table::BEGIN@45
3133569µs4.05msSQL::Translator::Schema::Table::::add_indexSQL::Translator::Schema::Table::add_index
3511451µs2.39msSQL::Translator::Schema::Table::::newSQL::Translator::Schema::Table::new
7022252µs276µsSQL::Translator::Schema::Table::::schemaSQL::Translator::Schema::Table::schema
6622245µs397µsSQL::Translator::Schema::Table::::get_indicesSQL::Translator::Schema::Table::get_indices
7021209µs259µsSQL::Translator::Schema::Table::::orderSQL::Translator::Schema::Table::order
3511190µs190µsSQL::Translator::Schema::Table::::CORE:sortSQL::Translator::Schema::Table::CORE:sort (opcode)
3511127µs127µsSQL::Translator::Schema::Table::::commentsSQL::Translator::Schema::Table::comments
351150µs50µsSQL::Translator::Schema::Table::::CORE:matchSQL::Translator::Schema::Table::CORE:match (opcode)
11122µs25µsSQL::Translator::Schema::Table::::BEGIN@40SQL::Translator::Schema::Table::BEGIN@40
11112µs64µsSQL::Translator::Schema::Table::::BEGIN@58SQL::Translator::Schema::Table::BEGIN@58
11110µs36µsSQL::Translator::Schema::Table::::BEGIN@46SQL::Translator::Schema::Table::BEGIN@46
1119µs68µsSQL::Translator::Schema::Table::::BEGIN@42SQL::Translator::Schema::Table::BEGIN@42
1118µs34µsSQL::Translator::Schema::Table::::BEGIN@41SQL::Translator::Schema::Table::BEGIN@41
1117µs59µsSQL::Translator::Schema::Table::::BEGIN@48SQL::Translator::Schema::Table::BEGIN@48
1116µs22µsSQL::Translator::Schema::Table::::BEGIN@50SQL::Translator::Schema::Table::BEGIN@50
0000s0sSQL::Translator::Schema::Table::::DESTROYSQL::Translator::Schema::Table::DESTROY
0000s0sSQL::Translator::Schema::Table::::__ANON__[:58]SQL::Translator::Schema::Table::__ANON__[:58]
0000s0sSQL::Translator::Schema::Table::::can_linkSQL::Translator::Schema::Table::can_link
0000s0sSQL::Translator::Schema::Table::::data_fieldsSQL::Translator::Schema::Table::data_fields
0000s0sSQL::Translator::Schema::Table::::drop_constraintSQL::Translator::Schema::Table::drop_constraint
0000s0sSQL::Translator::Schema::Table::::drop_fieldSQL::Translator::Schema::Table::drop_field
0000s0sSQL::Translator::Schema::Table::::drop_indexSQL::Translator::Schema::Table::drop_index
0000s0sSQL::Translator::Schema::Table::::equalsSQL::Translator::Schema::Table::equals
0000s0sSQL::Translator::Schema::Table::::field_namesSQL::Translator::Schema::Table::field_names
0000s0sSQL::Translator::Schema::Table::::fkey_constraintsSQL::Translator::Schema::Table::fkey_constraints
0000s0sSQL::Translator::Schema::Table::::fkey_fieldsSQL::Translator::Schema::Table::fkey_fields
0000s0sSQL::Translator::Schema::Table::::is_dataSQL::Translator::Schema::Table::is_data
0000s0sSQL::Translator::Schema::Table::::is_trivial_linkSQL::Translator::Schema::Table::is_trivial_link
0000s0sSQL::Translator::Schema::Table::::is_validSQL::Translator::Schema::Table::is_valid
0000s0sSQL::Translator::Schema::Table::::nonpkey_fieldsSQL::Translator::Schema::Table::nonpkey_fields
0000s0sSQL::Translator::Schema::Table::::optionsSQL::Translator::Schema::Table::options
0000s0sSQL::Translator::Schema::Table::::pkey_fieldsSQL::Translator::Schema::Table::pkey_fields
0000s0sSQL::Translator::Schema::Table::::unique_constraintsSQL::Translator::Schema::Table::unique_constraints
0000s0sSQL::Translator::Schema::Table::::unique_fieldsSQL::Translator::Schema::Table::unique_fields
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::Table;
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::Table - SQL::Translator table object
26
27=head1 SYNOPSIS
28
29 use SQL::Translator::Schema::Table;
30 my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
31
32=head1 DESCSIPTION
33
34C<SQL::Translator::Schema::Table> is the table object.
35
36=head1 METHODS
37
38=cut
39
40321µs228µs
# spent 25µs (22+3) within SQL::Translator::Schema::Table::BEGIN@40 which was called: # once (22µs+3µs) by SQL::Translator::Schema::BEGIN@50 at line 40
use strict;
# spent 25µs making 1 call to SQL::Translator::Schema::Table::BEGIN@40 # spent 3µs making 1 call to strict::import
41320µs261µs
# spent 34µs (8+27) within SQL::Translator::Schema::Table::BEGIN@41 which was called: # once (8µs+27µs) by SQL::Translator::Schema::BEGIN@50 at line 41
use SQL::Translator::Utils 'parse_list_arg';
# spent 34µs making 1 call to SQL::Translator::Schema::Table::BEGIN@41 # spent 27µs making 1 call to Exporter::import
42323µs2126µs
# spent 68µs (9+59) within SQL::Translator::Schema::Table::BEGIN@42 which was called: # once (9µs+59µs) by SQL::Translator::Schema::BEGIN@50 at line 42
use SQL::Translator::Schema::Constants;
# spent 68µs making 1 call to SQL::Translator::Schema::Table::BEGIN@42 # spent 59µs making 1 call to Exporter::import
43399µs11.81ms
# spent 1.81ms (1.54+271µs) within SQL::Translator::Schema::Table::BEGIN@43 which was called: # once (1.54ms+271µs) by SQL::Translator::Schema::BEGIN@50 at line 43
use SQL::Translator::Schema::Constraint;
# spent 1.81ms making 1 call to SQL::Translator::Schema::Table::BEGIN@43
443113µs12.79ms
# spent 2.79ms (1.74+1.05) within SQL::Translator::Schema::Table::BEGIN@44 which was called: # once (1.74ms+1.05ms) by SQL::Translator::Schema::BEGIN@50 at line 44
use SQL::Translator::Schema::Field;
# spent 2.79ms making 1 call to SQL::Translator::Schema::Table::BEGIN@44
453128µs11.07ms
# spent 1.07ms (752µs+321µs) within SQL::Translator::Schema::Table::BEGIN@45 which was called: # once (752µs+321µs) by SQL::Translator::Schema::BEGIN@50 at line 45
use SQL::Translator::Schema::Index;
# spent 1.07ms making 1 call to SQL::Translator::Schema::Table::BEGIN@45
46322µs262µs
# spent 36µs (10+26) within SQL::Translator::Schema::Table::BEGIN@46 which was called: # once (10µs+26µs) by SQL::Translator::Schema::BEGIN@50 at line 46
use Data::Dumper;
# spent 36µs making 1 call to SQL::Translator::Schema::Table::BEGIN@46 # spent 26µs making 1 call to Exporter::import
47
48320µs2112µs
# spent 59µs (7+53) within SQL::Translator::Schema::Table::BEGIN@48 which was called: # once (7µs+53µs) by SQL::Translator::Schema::BEGIN@50 at line 48
use base 'SQL::Translator::Schema::Object';
# spent 59µs making 1 call to SQL::Translator::Schema::Table::BEGIN@48 # spent 52µs making 1 call to base::import
49
50361µs238µs
# spent 22µs (6+16) within SQL::Translator::Schema::Table::BEGIN@50 which was called: # once (6µs+16µs) by SQL::Translator::Schema::BEGIN@50 at line 50
use vars qw( $VERSION );
# spent 22µs making 1 call to SQL::Translator::Schema::Table::BEGIN@50 # spent 16µs making 1 call to vars::import
51
5211µs$VERSION = '1.59';
53
54# Stringify to our name, being careful not to pass any args through so we don't
55# accidentally set it to undef. We also have to tweak bool so the object is
56# still true when it doesn't have a name (which shouldn't happen!).
57use overload
58
# spent 64µs (12+52) within SQL::Translator::Schema::Table::BEGIN@58 which was called: # once (12µs+52µs) by SQL::Translator::Schema::BEGIN@50 at line 61
'""' => sub { shift->name },
5911243.06ms11241.60ms
# spent 5.12ms (3.52+1.60) within SQL::Translator::Schema::Table::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Table.pm:59] which was called 1124 times, avg 5µs/call: # 240 times (748µs+365µs) by SQL::Translator::Schema::Field::table at line 590 of SQL/Translator/Schema/Field.pm, avg 5µs/call # 240 times (743µs+331µs) by SQL::Translator::Schema::Field::is_foreign_key at line 306 of SQL/Translator/Schema/Field.pm, avg 4µs/call # 240 times (704µs+308µs) by SQL::Translator::Schema::Field::name at line 472 of SQL/Translator/Schema/Field.pm, avg 4µs/call # 201 times (642µs+272µs) by SQL::Translator::Schema::Field::is_primary_key at line 383 of SQL/Translator/Schema/Field.pm, avg 5µs/call # 67 times (226µs+102µs) by SQL::Translator::Schema::Constraint::table at line 491 of SQL/Translator/Schema/Constraint.pm, avg 5µs/call # 35 times (142µs+44µs) by Class::Base::new at line 59 of Class/Base.pm, avg 5µs/call # 35 times (99µs+81µs) by SQL::Translator::Schema::Table::new at line 82, avg 5µs/call # 35 times (114µs+51µs) by SQL::Translator::Parser::DBIx::Class::parse at line 287 of SQL/Translator/Parser/DBIx/Class.pm, avg 5µs/call # 31 times (103µs+45µs) by SQL::Translator::Schema::Index::table at line 203 of SQL/Translator/Schema/Index.pm, avg 5µs/call
'bool' => sub { $_[0]->name || $_[0] },
# spent 1.60ms making 1124 calls to SQL::Translator::Schema::Table::name, avg 1µs/call
60152µs fallback => 1,
# spent 52µs making 1 call to overload::import
6132.77ms164µs;
# spent 64µs making 1 call to SQL::Translator::Schema::Table::BEGIN@58
62
63# ----------------------------------------------------------------------
64
6519µs165µs__PACKAGE__->_attributes( qw/schema name comments options order/ );
# spent 65µs making 1 call to SQL::Translator::Schema::Object::_attributes
66
67=pod
68
69=head2 new
70
71Object constructor.
72
73 my $table = SQL::Translator::Schema::Table->new(
74 schema => $schema,
75 name => 'foo',
76 );
77
78=cut
79
80
# spent 2.39ms (451µs+1.94) within SQL::Translator::Schema::Table::new which was called 35 times, avg 68µs/call: # 35 times (451µs+1.94ms) by SQL::Translator::Parser::DBIx::Class::parse at line 101 of SQL/Translator/Parser/DBIx/Class.pm, avg 68µs/call
sub new {
81140401µs my $class = shift;
82120µs701.94ms my $self = $class->SUPER::new (@_)
# spent 1.76ms making 35 calls to Class::Base::new, avg 50µs/call # spent 181µs making 35 calls to SQL::Translator::Schema::Table::__ANON__[SQL/Translator/Schema/Table.pm:59], avg 5µs/call
83 or return;
84
85 $self->{_order} = { map { $_ => 0 } qw/
86 field
87 /};
88
89 return $self;
90}
91
- -
94# ----------------------------------------------------------------------
95
# spent 13.4ms (1.79+11.6) within SQL::Translator::Schema::Table::add_constraint which was called 67 times, avg 200µs/call: # 35 times (1.05ms+6.35ms) by SQL::Translator::Schema::Table::primary_key at line 828, avg 211µs/call # 29 times (700µs+4.94ms) by SQL::Translator::Parser::DBIx::Class::parse at line 236 of SQL/Translator/Parser/DBIx/Class.pm, avg 195µs/call # 3 times (48µs+335µs) by SQL::Translator::Parser::DBIx::Class::parse at line 130 of SQL/Translator/Parser/DBIx/Class.pm, avg 128µs/call
sub add_constraint {
96
97=pod
98
99=head2 add_constraint
100
101Add a constraint to the table. Returns the newly created
102C<SQL::Translator::Schema::Constraint> object.
103
104 my $c1 = $table->add_constraint(
105 name => 'pk',
106 type => PRIMARY_KEY,
107 fields => [ 'foo_id' ],
108 );
109
110 my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
111 $c2 = $table->add_constraint( $constraint );
112
113=cut
114
115603881µs my $self = shift;
116 my $constraint_class = 'SQL::Translator::Schema::Constraint';
117 my $constraint;
118
119201509µs6762µs if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
# spent 62µs making 67 calls to UNIVERSAL::isa, avg 921ns/call
120 $constraint = shift;
121 $constraint->table( $self );
122 }
123 else {
124 my %args = @_;
125 $args{'table'} = $self;
126678.27ms $constraint = $constraint_class->new( \%args ) or
# spent 8.27ms making 67 calls to Class::Base::new, avg 123µs/call
127 return $self->error( $constraint_class->error );
128 }
129
130 #
131 # If we're trying to add a PK when one is already defined,
132 # then just add the fields to the existing definition.
133 #
134 my $ok = 1;
13567550µs my $pk = $self->primary_key;
# spent 1.19ms making 67 calls to SQL::Translator::Schema::Table::primary_key, avg 18µs/call, recursion: max depth 1, sum of overlapping time 636µs
136134999µs if ( $pk && $constraint->type eq PRIMARY_KEY ) {
# spent 855µs making 35 calls to SQL::Translator::Schema::Constraint::fields, avg 24µs/call # spent 144µs making 99 calls to SQL::Translator::Schema::Constraint::type, avg 1µs/call
137 $self->primary_key( $constraint->fields );
138 $pk->name($constraint->name) if $constraint->name;
139 my %extra = $constraint->extra;
140 $pk->extra(%extra) if keys %extra;
141 $constraint = $pk;
142 $ok = 0;
143 }
144 elsif ( $constraint->type eq PRIMARY_KEY ) {
145 for my $fname ( $constraint->fields ) {
14639168µs1171.10ms if ( my $f = $self->get_field( $fname ) ) {
# spent 850µs making 39 calls to SQL::Translator::Schema::Table::get_field, avg 22µs/call # spent 149µs making 39 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:58], avg 4µs/call # spent 105µs making 39 calls to SQL::Translator::Schema::Field::is_primary_key, avg 3µs/call
147 $f->is_primary_key( 1 );
148 }
149 }
150 }
151 #
152 # See if another constraint of the same type
153 # covers the same fields. -- This doesn't work! ky
154 #
155# elsif ( $constraint->type ne CHECK_C ) {
156# my @field_names = $constraint->fields;
157# for my $c (
158# grep { $_->type eq $constraint->type }
159# $self->get_constraints
160# ) {
161# my %fields = map { $_, 1 } $c->fields;
162# for my $field_name ( @field_names ) {
163# if ( $fields{ $field_name } ) {
164# $constraint = $c;
165# $ok = 0;
166# last;
167# }
168# }
169# last unless $ok;
170# }
171# }
172
173 if ( $ok ) {
174 push @{ $self->{'constraints'} }, $constraint;
175 }
176
177 return $constraint;
178}
179
180# ----------------------------------------------------------------------
181sub drop_constraint {
182
183=pod
184
185=head2 drop_constraint
186
187Remove a constraint from the table. Returns the constraint object if the index
188was found and removed, an error otherwise. The single parameter can be either
189an index name or an C<SQL::Translator::Schema::Constraint> object.
190
191 $table->drop_constraint('myconstraint');
192
193=cut
194
195 my $self = shift;
196 my $constraint_class = 'SQL::Translator::Schema::Constraint';
197 my $constraint_name;
198
199 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
200 $constraint_name = shift->name;
201 }
202 else {
203 $constraint_name = shift;
204 }
205
206 if ( ! grep { $_->name eq $constraint_name } @ { $self->{'constraints'} } ) {
207 return $self->error(qq[Can't drop constraint: "$constraint_name" doesn't exist]);
208 }
209
210 my @cs = @{ $self->{'constraints'} };
211 my ($constraint_id) = grep { $cs[$_]->name eq $constraint_name } (0..$#cs);
212 my $constraint = splice(@{$self->{'constraints'}}, $constraint_id, 1);
213
214 return $constraint;
215}
216
217# ----------------------------------------------------------------------
218
# spent 4.05ms (569µs+3.49) within SQL::Translator::Schema::Table::add_index which was called 31 times, avg 131µs/call: # 29 times (534µs+3.21ms) by SQL::Translator::Parser::DBIx::Class::parse at line 257 of SQL/Translator/Parser/DBIx/Class.pm, avg 129µs/call # once (16µs+180µs) by Tapper::Schema::ReportsDB::Result::Report::sqlt_deploy_hook at line 74 of Tapper/Schema/ReportsDB/Result/Report.pm # once (19µs+101µs) by Tapper::Schema::ReportsDB::Result::Suite::sqlt_deploy_hook at line 33 of Tapper/Schema/ReportsDB/Result/Suite.pm
sub add_index {
219
220=pod
221
222=head2 add_index
223
224Add an index to the table. Returns the newly created
225C<SQL::Translator::Schema::Index> object.
226
227 my $i1 = $table->add_index(
228 name => 'name',
229 fields => [ 'name' ],
230 type => 'normal',
231 );
232
233 my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
234 $i2 = $table->add_index( $index );
235
236=cut
237
238217328µs my $self = shift;
239 my $index_class = 'SQL::Translator::Schema::Index';
240 my $index;
241
24293195µs3125µs if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
# spent 25µs making 31 calls to UNIVERSAL::isa, avg 816ns/call
243 $index = shift;
244 $index->table( $self );
245 }
246 else {
247 my %args = @_;
248 $args{'table'} = $self;
249312.42ms $index = $index_class->new( \%args ) or return
# spent 2.42ms making 31 calls to Class::Base::new, avg 78µs/call
250 $self->error( $index_class->error );
251 }
25231226µs foreach my $ex_index ($self->get_indices) {
# spent 226µs making 31 calls to SQL::Translator::Schema::Table::get_indices, avg 7µs/call
2531129µs11814µs return if ($ex_index->equals($index));
# spent 814µs making 11 calls to SQL::Translator::Schema::Index::equals, avg 74µs/call
254 }
255 push @{ $self->{'indices'} }, $index;
256 return $index;
257}
258
259# ----------------------------------------------------------------------
260sub drop_index {
261
262=pod
263
264=head2 drop_index
265
266Remove an index from the table. Returns the index object if the index was
267found and removed, an error otherwise. The single parameter can be either
268an index name of an C<SQL::Translator::Schema::Index> object.
269
270 $table->drop_index('myindex');
271
272=cut
273
274 my $self = shift;
275 my $index_class = 'SQL::Translator::Schema::Index';
276 my $index_name;
277
278 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
279 $index_name = shift->name;
280 }
281 else {
282 $index_name = shift;
283 }
284
285 if ( ! grep { $_->name eq $index_name } @{ $self->{'indices'} }) {
286 return $self->error(qq[Can't drop index: "$index_name" doesn't exist]);
287 }
288
289 my @is = @{ $self->{'indices'} };
290 my ($index_id) = grep { $is[$_]->name eq $index_name } (0..$#is);
291 my $index = splice(@{$self->{'indices'}}, $index_id, 1);
292
293 return $index;
294}
295
296# ----------------------------------------------------------------------
297
# spent 45.2ms (4.66+40.5) within SQL::Translator::Schema::Table::add_field which was called 240 times, avg 188µs/call: # 240 times (4.66ms+40.5ms) by SQL::Translator::Parser::DBIx::Class::parse at line 120 of SQL/Translator/Parser/DBIx/Class.pm, avg 188µs/call
sub add_field {
298
299=pod
300
301=head2 add_field
302
303Add an field to the table. Returns the newly created
304C<SQL::Translator::Schema::Field> object. The "name" parameter is
305required. If you try to create a field with the same name as an
306existing field, you will get an error and the field will not be created.
307
308 my $f1 = $table->add_field(
309 name => 'foo_id',
310 data_type => 'integer',
311 size => 11,
312 );
313
314 my $f2 = SQL::Translator::Schema::Field->new(
315 name => 'name',
316 table => $table,
317 );
318 $f2 = $table->add_field( $field2 ) or die $table->error;
319
320=cut
321
32219202.35ms my $self = shift;
323 my $field_class = 'SQL::Translator::Schema::Field';
324 my $field;
325
3267201.61ms240219µs if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
# spent 219µs making 240 calls to UNIVERSAL::isa, avg 913ns/call
327 $field = shift;
328 $field->table( $self );
329 }
330 else {
331 my %args = @_;
332 $args{'table'} = $self;
3331127µs48038.8ms $field = $field_class->new( \%args ) or return
# spent 37.9ms making 240 calls to Class::Base::new, avg 158µs/call # spent 957µs making 240 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:58], avg 4µs/call
334 $self->error( $field_class->error );
335 }
336
3372401.18ms $field->order( ++$self->{_order}{field} );
# spent 1.18ms making 240 calls to SQL::Translator::Schema::Field::order, avg 5µs/call
338 # We know we have a name as the Field->new above errors if none given.
339240335µs my $field_name = $field->name;
# spent 335µs making 240 calls to SQL::Translator::Schema::Field::name, avg 1µs/call
340
341240212µs if ( exists $self->{'fields'}{ $field_name } ) {
342 return $self->error(qq[Can't create field: "$field_name" exists]);
343 }
344 else {
345 $self->{'fields'}{ $field_name } = $field;
346 }
347
348 return $field;
349}
350# ----------------------------------------------------------------------
351sub drop_field {
352
353=pod
354
355=head2 drop_field
356
357Remove a field from the table. Returns the field object if the field was
358found and removed, an error otherwise. The single parameter can be either
359a field name or an C<SQL::Translator::Schema::Field> object.
360
361 $table->drop_field('myfield');
362
363=cut
364
365 my $self = shift;
366 my $field_class = 'SQL::Translator::Schema::Field';
367 my $field_name;
368
369 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
370 $field_name = shift->name;
371 }
372 else {
373 $field_name = shift;
374 }
375 my %args = @_;
376 my $cascade = $args{'cascade'};
377
378 if ( ! exists $self->{'fields'}{ $field_name } ) {
379 return $self->error(qq[Can't drop field: "$field_name" doesn't exists]);
380 }
381
382 my $field = delete $self->{'fields'}{ $field_name };
383
384 if ( $cascade ) {
385 # Remove this field from all indices using it
386 foreach my $i ($self->get_indices()) {
387 my @fs = $i->fields();
388 @fs = grep { $_ ne $field->name } @fs;
389 $i->fields(@fs);
390 }
391
392 # Remove this field from all constraints using it
393 foreach my $c ($self->get_constraints()) {
394 my @cs = $c->fields();
395 @cs = grep { $_ ne $field->name } @cs;
396 $c->fields(@cs);
397 }
398 }
399
400 return $field;
401}
402
403# ----------------------------------------------------------------------
404
# spent 127µs within SQL::Translator::Schema::Table::comments which was called 35 times, avg 4µs/call: # 35 times (127µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 196 of SQL/Translator/Producer/SQLite.pm, avg 4µs/call
sub comments {
405
406=pod
407
408=head2 comments
409
410Get or set the comments on a table. May be called several times to
411set and it will accumulate the comments. Called in an array context,
412returns each comment individually; called in a scalar context, returns
413all the comments joined on newlines.
414
415 $table->comments('foo');
416 $table->comments('bar');
417 print join( ', ', $table->comments ); # prints "foo, bar"
418
419=cut
420
42114081µs my $self = shift;
422 my @comments = ref $_[0] ? @{ $_[0] } : @_;
423
424 for my $arg ( @comments ) {
425 $arg = $arg->[0] if ref $arg;
426 push @{ $self->{'comments'} }, $arg if defined $arg && $arg;
427 }
428
4293580µs if ( @{ $self->{'comments'} || [] } ) {
430 return wantarray
431 ? @{ $self->{'comments'} }
432 : join( "\n", @{ $self->{'comments'} } )
433 ;
434 }
435 else {
436 return wantarray ? () : undef;
437 }
438}
439
440# ----------------------------------------------------------------------
441
# spent 3.50ms (2.22+1.28) within SQL::Translator::Schema::Table::get_constraints which was called 853 times, avg 4µs/call: # 543 times (1.25ms+529µs) by SQL::Translator::Schema::Table::primary_key at line 840, avg 3µs/call # 240 times (795µs+657µs) by SQL::Translator::Schema::Field::is_foreign_key at line 307 of SQL/Translator/Schema/Field.pm, avg 6µs/call # 35 times (110µs+97µs) by SQL::Translator::Schema::Table::primary_key at line 820, avg 6µs/call # 35 times (58µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 236 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call
sub get_constraints {
442
443=pod
444
445=head2 get_constraints
446
447Returns all the constraint objects as an array or array reference.
448
449 my @constraints = $table->get_constraints;
450
451=cut
452
45317061.28ms my $self = shift;
454
4559161.17ms if ( ref $self->{'constraints'} ) {
456 return wantarray
457 ? @{ $self->{'constraints'} } : $self->{'constraints'};
458 }
459 else {
4604581.28ms $self->error('No constraints');
# spent 1.28ms making 458 calls to Class::Base::error, avg 3µs/call
461 return wantarray ? () : undef;
462 }
463}
464
465# ----------------------------------------------------------------------
466
# spent 397µs (245+152) within SQL::Translator::Schema::Table::get_indices which was called 66 times, avg 6µs/call: # 35 times (112µs+60µs) by SQL::Translator::Producer::SQLite::create_table at line 228 of SQL/Translator/Producer/SQLite.pm, avg 5µs/call # 31 times (133µs+93µs) by SQL::Translator::Schema::Table::add_index at line 252, avg 7µs/call
sub get_indices {
467
468=pod
469
470=head2 get_indices
471
472Returns all the index objects as an array or array reference.
473
474 my @indices = $table->get_indices;
475
476=cut
477
478132141µs my $self = shift;
479
48070137µs if ( ref $self->{'indices'} ) {
481 return wantarray
482 ? @{ $self->{'indices'} }
483 : $self->{'indices'};
484 }
485 else {
48635152µs $self->error('No indices');
# spent 152µs making 35 calls to Class::Base::error, avg 4µs/call
487 return wantarray ? () : undef;
488 }
489}
490
491# ----------------------------------------------------------------------
492
# spent 3.87ms (2.61+1.25) within SQL::Translator::Schema::Table::get_field which was called 778 times, avg 5µs/call: # 460 times (1.11ms+0s) by SQL::Translator::Schema::Constraint::fields at line 254 of SQL/Translator/Schema/Constraint.pm, avg 2µs/call # 240 times (1.04ms+760µs) by SQL::Translator::Schema::Field::name at line 472 of SQL/Translator/Schema/Field.pm, avg 8µs/call # 39 times (355µs+495µs) by SQL::Translator::Schema::Table::add_constraint at line 146, avg 22µs/call # 39 times (100µs+0s) by SQL::Translator::Schema::Table::primary_key at line 815, avg 3µs/call
sub get_field {
493
494=pod
495
496=head2 get_field
497
498Returns a field by the name provided.
499
500 my $field = $table->get_field('foo');
501
502=cut
503
50444282.79ms my $self = shift;
505113µs39152µs my $field_name = shift or return $self->error('No field name');
# spent 152µs making 39 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:58], avg 4µs/call
506 my $case_insensitive = shift;
507 if ( $case_insensitive ) {
508 $field_name = uc($field_name);
509 foreach my $field ( keys %{$self->{fields}} ) {
510 return $self->{fields}{$field} if $field_name eq uc($field);
511 }
512 return $self->error(qq[Field "$field_name" does not exist]);
513 }
514121µs279949µs return $self->error( qq[Field "$field_name" does not exist] ) unless
# spent 760µs making 240 calls to Class::Base::error, avg 3µs/call # spent 189µs making 39 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:57], avg 5µs/call
515 exists $self->{'fields'}{ $field_name };
516173µs39154µs return $self->{'fields'}{ $field_name };
# spent 154µs making 39 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:57], avg 4µs/call
517}
518
519# ----------------------------------------------------------------------
520
# spent 1.63ms (1.00+627µs) within SQL::Translator::Schema::Table::get_fields which was called 35 times, avg 47µs/call: # 35 times (1.00ms+627µs) by SQL::Translator::Producer::SQLite::create_table at line 175 of SQL/Translator/Producer/SQLite.pm, avg 47µs/call
sub get_fields {
521
522=pod
523
524=head2 get_fields
525
526Returns all the field objects as an array or array reference.
527
528 my @fields = $table->get_fields;
529
530=cut
531
532105639µs my $self = shift;
533 my @fields =
534 map { $_->[1] }
535240437µs sort { $a->[0] <=> $b->[0] }
# spent 437µs making 240 calls to SQL::Translator::Schema::Field::order, avg 2µs/call
536 map { [ $_->order, $_ ] }
537240378µs35190µs values %{ $self->{'fields'} || {} };
# spent 190µs making 35 calls to SQL::Translator::Schema::Table::CORE:sort, avg 5µs/call
538
539 if ( @fields ) {
540 return wantarray ? @fields : \@fields;
541 }
542 else {
543 $self->error('No fields');
544 return wantarray ? () : undef;
545 }
546}
547
548# ----------------------------------------------------------------------
549sub is_valid {
550
551=pod
552
553=head2 is_valid
554
555Determine whether the view is valid or not.
556
557 my $ok = $view->is_valid;
558
559=cut
560
561 my $self = shift;
562 return $self->error('No name') unless $self->name;
563 return $self->error('No fields') unless $self->get_fields;
564
565 for my $object (
566 $self->get_fields, $self->get_indices, $self->get_constraints
567 ) {
568 return $object->error unless $object->is_valid;
569 }
570
571 return 1;
572}
573
574# ----------------------------------------------------------------------
575sub is_trivial_link {
576
577=pod
578
579=head2 is_trivial_link
580
581True if table has no data (non-key) fields and only uses single key joins.
582
583=cut
584
585 my $self = shift;
586 return 0 if $self->is_data;
587 return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'};
588
589 $self->{'is_trivial_link'} = 1;
590
591 my %fk = ();
592
593 foreach my $field ( $self->get_fields ) {
594 next unless $field->is_foreign_key;
595 $fk{$field->foreign_key_reference->reference_table}++;
596 }
597
598 foreach my $referenced (keys %fk){
599 if($fk{$referenced} > 1){
600 $self->{'is_trivial_link'} = 0;
601 last;
602 }
603 }
604
605 return $self->{'is_trivial_link'};
606
607}
608
609sub is_data {
610
611=pod
612
613=head2 is_data
614
615Returns true if the table has some non-key fields.
616
617=cut
618
619 my $self = shift;
620 return $self->{'is_data'} if defined $self->{'is_data'};
621
622 $self->{'is_data'} = 0;
623
624 foreach my $field ( $self->get_fields ) {
625 if ( !$field->is_primary_key and !$field->is_foreign_key ) {
626 $self->{'is_data'} = 1;
627 return $self->{'is_data'};
628 }
629 }
630
631 return $self->{'is_data'};
632}
633
634# ----------------------------------------------------------------------
635sub can_link {
636
637=pod
638
639=head2 can_link
640
641Determine whether the table can link two arg tables via many-to-many.
642
643 my $ok = $table->can_link($table1,$table2);
644
645=cut
646
647 my ( $self, $table1, $table2 ) = @_;
648
649 return $self->{'can_link'}{ $table1->name }{ $table2->name }
650 if defined $self->{'can_link'}{ $table1->name }{ $table2->name };
651
652 if ( $self->is_data == 1 ) {
653 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
654 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
655 return $self->{'can_link'}{ $table1->name }{ $table2->name };
656 }
657
658 my %fk = ();
659
660 foreach my $field ( $self->get_fields ) {
661 if ( $field->is_foreign_key ) {
662 push @{ $fk{ $field->foreign_key_reference->reference_table } },
663 $field->foreign_key_reference;
664 }
665 }
666
667 if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
668 {
669 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
670 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
671 return $self->{'can_link'}{ $table1->name }{ $table2->name };
672 }
673
674 # trivial traversal, only one way to link the two tables
675 if ( scalar( @{ $fk{ $table1->name } } == 1 )
676 and scalar( @{ $fk{ $table2->name } } == 1 ) )
677 {
678 $self->{'can_link'}{ $table1->name }{ $table2->name } =
679 [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
680 $self->{'can_link'}{ $table1->name }{ $table2->name } =
681 [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
682
683 # non-trivial traversal. one way to link table2,
684 # many ways to link table1
685 }
686 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
687 and scalar( @{ $fk{ $table2->name } } == 1 ) )
688 {
689 $self->{'can_link'}{ $table1->name }{ $table2->name } =
690 [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
691 $self->{'can_link'}{ $table2->name }{ $table1->name } =
692 [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
693
694 # non-trivial traversal. one way to link table1,
695 # many ways to link table2
696 }
697 elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
698 and scalar( @{ $fk{ $table2->name } } > 1 ) )
699 {
700 $self->{'can_link'}{ $table1->name }{ $table2->name } =
701 [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
702 $self->{'can_link'}{ $table2->name }{ $table1->name } =
703 [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
704
705 # non-trivial traversal. many ways to link table1 and table2
706 }
707 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
708 and scalar( @{ $fk{ $table2->name } } > 1 ) )
709 {
710 $self->{'can_link'}{ $table1->name }{ $table2->name } =
711 [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
712 $self->{'can_link'}{ $table2->name }{ $table1->name } =
713 [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
714
715 # one of the tables didn't export a key
716 # to this table, no linking possible
717 }
718 else {
719 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
720 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
721 }
722
723 return $self->{'can_link'}{ $table1->name }{ $table2->name };
724}
725
726# ----------------------------------------------------------------------
727
# spent 2.08ms (2.00+81µs) within SQL::Translator::Schema::Table::name which was called 1263 times, avg 2µs/call: # 1124 times (1.60ms+0s) by SQL::Translator::Schema::Table::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Table.pm:59] at line 59, avg 1µs/call # 35 times (219µs+81µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 9µs/call # 35 times (73µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 167 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call # 35 times (60µs+0s) by SQL::Translator::Schema::add_table at line 164 of SQL/Translator/Schema.pm, avg 2µs/call # 31 times (44µs+0s) by SQL::Translator::Producer::SQLite::create_index at line 346 of SQL/Translator/Producer/SQLite.pm, avg 1µ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 name {
728
729=pod
730
731=head2 name
732
733Get or set the table's name.
734
735Errors ("No table name") if you try to set a blank name.
736
737If provided an argument, checks the schema object for a table of
738that name and disallows the change if one exists (setting the error to
739"Can't use table name "%s": table exists").
740
741 my $table_name = $table->name('foo');
742
743=cut
744
74537893.50ms my $self = shift;
746
747105114µs if ( @_ ) {
748 my $arg = shift || return $self->error( "No table name" );
7493581µs if ( my $schema = $self->schema ) {
# spent 81µs making 35 calls to SQL::Translator::Schema::Table::schema, avg 2µs/call
750 return $self->error( qq[Can't use table name "$arg": table exists] )
751 if $schema->get_table( $arg );
752 }
753 $self->{'name'} = $arg;
754 }
755
756 return $self->{'name'} || '';
757}
758
759# ----------------------------------------------------------------------
760
# spent 276µs (252+23) within SQL::Translator::Schema::Table::schema which was called 70 times, avg 4µs/call: # 35 times (171µs+23µs) by SQL::Translator::Schema::add_table at line 152 of SQL/Translator/Schema.pm, avg 6µs/call # 35 times (81µs+0s) by SQL::Translator::Schema::Table::name at line 749, avg 2µs/call
sub schema {
761
762=pod
763
764=head2 schema
765
766Get or set the table's schema object.
767
768 my $schema = $table->schema;
769
770=cut
771
772210203µs my $self = shift;
77370139µs if ( my $arg = shift ) {
7743523µs return $self->error('Not a schema object') unless
# spent 23µs making 35 calls to UNIVERSAL::isa, avg 669ns/call
775 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
776 $self->{'schema'} = $arg;
777 }
778
779 return $self->{'schema'};
780}
781
782# ----------------------------------------------------------------------
783
# spent 16.8ms (4.53+12.3) within SQL::Translator::Schema::Table::primary_key which was called 578 times, avg 29µs/call: # 240 times (1.78ms+1.70ms) by SQL::Translator::Producer::SQLite::create_field at line 297 of SQL/Translator/Producer/SQLite.pm, avg 15µs/call # 201 times (1.31ms+2.01ms) by SQL::Translator::Schema::Field::is_primary_key at line 384 of SQL/Translator/Schema/Field.pm, avg 17µs/call # 67 times (522µs+28µs) by SQL::Translator::Schema::Table::add_constraint at line 135, avg 8µs/call # 35 times (613µs+8.23ms) by SQL::Translator::Parser::DBIx::Class::parse at line 126 of SQL/Translator/Parser/DBIx/Class.pm, avg 253µs/call # 35 times (296µs+325µs) by SQL::Translator::Producer::SQLite::create_table at line 205 of SQL/Translator/Producer/SQLite.pm, avg 18µs/call
sub primary_key {
784
785=pod
786
787=head2 primary_key
788
789Gets or sets the table's primary key(s). Takes one or more field
790names (as a string, list or array[ref]) as an argument. If the field
791names are present, it will create a new PK if none exists, or it will
792add to the fields of an existing PK (and will unique the field names).
793Returns the C<SQL::Translator::Schema::Constraint> object representing
794the primary key.
795
796These are eqivalent:
797
798 $table->primary_key('id');
799 $table->primary_key(['name']);
800 $table->primary_key('id','name']);
801 $table->primary_key(['id','name']);
802 $table->primary_key('id,name');
803 $table->primary_key(qw[ id name ]);
804
805 my $pk = $table->primary_key;
806
807=cut
808
80930731.47ms my $self = shift;
8105782.72ms my $fields = parse_list_arg( @_ );
# spent 2.72ms making 578 calls to SQL::Translator::Utils::parse_list_arg, avg 5µs/call
811
812 my $constraint;
813140194µs if ( @$fields ) {
814 for my $f ( @$fields ) {
81539114µs78267µs return $self->error(qq[Invalid field "$f"]) unless
# spent 167µs making 39 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:58], avg 4µs/call # spent 100µs making 39 calls to SQL::Translator::Schema::Table::get_field, avg 3µs/call
816 $self->get_field($f);
817 }
818
819 my $has_pk;
82035207µs for my $c ( $self->get_constraints ) {
# spent 207µs making 35 calls to SQL::Translator::Schema::Table::get_constraints, avg 6µs/call
821 if ( $c->type eq PRIMARY_KEY ) {
822 $has_pk = 1;
823 $c->fields( @{ $c->fields }, @$fields );
824 $constraint = $c;
825 }
826 }
827
828357.40ms unless ( $has_pk ) {
# spent 7.40ms making 35 calls to SQL::Translator::Schema::Table::add_constraint, avg 211µs/call
829 $constraint = $self->add_constraint(
830 type => PRIMARY_KEY,
831 fields => $fields,
832 ) or return;
833 }
834 }
835
836543787µs if ( $constraint ) {
837 return $constraint;
838 }
839 else {
8405431.78ms for my $c ( $self->get_constraints ) {
# spent 1.78ms making 543 calls to SQL::Translator::Schema::Table::get_constraints, avg 3µs/call
8413601.08ms360564µs return $c if $c->type eq PRIMARY_KEY;
# spent 564µs making 360 calls to SQL::Translator::Schema::Constraint::type, avg 2µs/call
842 }
843 }
844
845 return;
846}
847
848# ----------------------------------------------------------------------
849sub options {
850
851=pod
852
853=head2 options
854
855Get or set the table's options (e.g., table types for MySQL). Returns
856an array or array reference.
857
858 my @options = $table->options;
859
860=cut
861
862 my $self = shift;
863 my $options = parse_list_arg( @_ );
864
865 push @{ $self->{'options'} }, @$options;
866
867 if ( ref $self->{'options'} ) {
868 return wantarray ? @{ $self->{'options'} || [] } : ($self->{'options'} || '');
869 }
870 else {
871 return wantarray ? () : [];
872 }
873}
874
875# ----------------------------------------------------------------------
876
# spent 259µs (209+50) within SQL::Translator::Schema::Table::order which was called 70 times, avg 4µs/call: # 35 times (139µs+50µs) by SQL::Translator::Schema::add_table at line 161 of SQL/Translator/Schema.pm, avg 5µs/call # 35 times (70µs+0s) by SQL::Translator::Schema::get_tables at line 605 of SQL/Translator/Schema.pm, avg 2µs/call
sub order {
877
878=pod
879
880=head2 order
881
882Get or set the table's order.
883
884 my $order = $table->order(3);
885
886=cut
887
888210319µs my ( $self, $arg ) = @_;
889
8903550µs if ( defined $arg && $arg =~ /^\d+$/ ) {
# spent 50µs making 35 calls to SQL::Translator::Schema::Table::CORE:match, avg 1µs/call
891 $self->{'order'} = $arg;
892 }
893
894 return $self->{'order'} || 0;
895}
896
897# ----------------------------------------------------------------------
898sub field_names {
899
900=head2 field_names
901
902Read-only method to return a list or array ref of the field names. Returns undef
903or an empty list if the table has no fields set. Useful if you want to
904avoid the overload magic of the Field objects returned by the get_fields method.
905
906 my @names = $constraint->field_names;
907
908=cut
909
910 my $self = shift;
911 my @fields =
912 map { $_->name }
913 sort { $a->order <=> $b->order }
914 values %{ $self->{'fields'} || {} };
915
916 if ( @fields ) {
917 return wantarray ? @fields : \@fields;
918 }
919 else {
920 $self->error('No fields');
921 return wantarray ? () : undef;
922 }
923}
924
925# ----------------------------------------------------------------------
926sub equals {
927
928=pod
929
930=head2 equals
931
932Determines if this table is the same as another
933
934 my $isIdentical = $table1->equals( $table2 );
935
936=cut
937
938 my $self = shift;
939 my $other = shift;
940 my $case_insensitive = shift;
941
942 return 0 unless $self->SUPER::equals($other);
943 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
944 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
945 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
946
947 # Fields
948 # Go through our fields
949 my %checkedFields;
950 foreach my $field ( $self->get_fields ) {
951 my $otherField = $other->get_field($field->name, $case_insensitive);
952 return 0 unless $field->equals($otherField, $case_insensitive);
953 $checkedFields{$field->name} = 1;
954 }
955 # Go through the other table's fields
956 foreach my $otherField ( $other->get_fields ) {
957 next if $checkedFields{$otherField->name};
958 return 0;
959 }
960
961 # Constraints
962 # Go through our constraints
963 my %checkedConstraints;
964CONSTRAINT:
965 foreach my $constraint ( $self->get_constraints ) {
966 foreach my $otherConstraint ( $other->get_constraints ) {
967 if ( $constraint->equals($otherConstraint, $case_insensitive) ) {
968 $checkedConstraints{$otherConstraint} = 1;
969 next CONSTRAINT;
970 }
971 }
972 return 0;
973 }
974 # Go through the other table's constraints
975CONSTRAINT2:
976 foreach my $otherConstraint ( $other->get_constraints ) {
977 next if $checkedFields{$otherConstraint};
978 foreach my $constraint ( $self->get_constraints ) {
979 if ( $otherConstraint->equals($constraint, $case_insensitive) ) {
980 next CONSTRAINT2;
981 }
982 }
983 return 0;
984 }
985
986 # Indices
987 # Go through our indices
988 my %checkedIndices;
989INDEX:
990 foreach my $index ( $self->get_indices ) {
991 foreach my $otherIndex ( $other->get_indices ) {
992 if ( $index->equals($otherIndex, $case_insensitive) ) {
993 $checkedIndices{$otherIndex} = 1;
994 next INDEX;
995 }
996 }
997 return 0;
998 }
999 # Go through the other table's indices
1000INDEX2:
1001 foreach my $otherIndex ( $other->get_indices ) {
1002 next if $checkedIndices{$otherIndex};
1003 foreach my $index ( $self->get_indices ) {
1004 if ( $otherIndex->equals($index, $case_insensitive) ) {
1005 next INDEX2;
1006 }
1007 }
1008 return 0;
1009 }
1010
1011 return 1;
1012}
1013
1014# ----------------------------------------------------------------------
1015
1016=head1 LOOKUP METHODS
1017
1018The following are a set of shortcut methods for getting commonly used lists of
1019fields and constraints. They all return lists or array refs of Field or
1020Constraint objects.
1021
1022=over 4
1023
1024=item pkey_fields
1025
1026The primary key fields.
1027
1028=item fkey_fields
1029
1030All foreign key fields.
1031
1032=item nonpkey_fields
1033
1034All the fields except the primary key.
1035
1036=item data_fields
1037
1038All non key fields.
1039
1040=item unique_fields
1041
1042All fields with unique constraints.
1043
1044=item unique_constraints
1045
1046All this tables unique constraints.
1047
1048=item fkey_constraints
1049
1050All this tables foreign key constraints. (See primary_key method to get the
1051primary key constraint)
1052
1053=back
1054
1055=cut
1056
1057sub pkey_fields {
1058 my $me = shift;
1059 my @fields = grep { $_->is_primary_key } $me->get_fields;
1060 return wantarray ? @fields : \@fields;
1061}
1062
1063# ----------------------------------------------------------------------
1064sub fkey_fields {
1065 my $me = shift;
1066 my @fields;
1067 push @fields, $_->fields foreach $me->fkey_constraints;
1068 return wantarray ? @fields : \@fields;
1069}
1070
1071# ----------------------------------------------------------------------
1072sub nonpkey_fields {
1073 my $me = shift;
1074 my @fields = grep { !$_->is_primary_key } $me->get_fields;
1075 return wantarray ? @fields : \@fields;
1076}
1077
1078# ----------------------------------------------------------------------
1079sub data_fields {
1080 my $me = shift;
1081 my @fields =
1082 grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields;
1083 return wantarray ? @fields : \@fields;
1084}
1085
1086# ----------------------------------------------------------------------
1087sub unique_fields {
1088 my $me = shift;
1089 my @fields;
1090 push @fields, $_->fields foreach $me->unique_constraints;
1091 return wantarray ? @fields : \@fields;
1092}
1093
1094# ----------------------------------------------------------------------
1095sub unique_constraints {
1096 my $me = shift;
1097 my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
1098 return wantarray ? @cons : \@cons;
1099}
1100
1101# ----------------------------------------------------------------------
1102sub fkey_constraints {
1103 my $me = shift;
1104 my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints;
1105 return wantarray ? @cons : \@cons;
1106}
1107
1108# ----------------------------------------------------------------------
1109sub DESTROY {
1110 my $self = shift;
1111 undef $self->{'schema'}; # destroy cyclical reference
1112 undef $_ for @{ $self->{'constraints'} };
1113 undef $_ for @{ $self->{'indices'} };
1114 undef $_ for values %{ $self->{'fields'} };
1115}
1116
111715µs1;
1118
1119# ----------------------------------------------------------------------
1120
1121=pod
1122
1123=head1 AUTHORS
1124
1125Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1126Allen Day E<lt>allenday@ucla.eduE<gt>.
1127
1128=cut
 
# spent 50µs within SQL::Translator::Schema::Table::CORE:match which was called 35 times, avg 1µs/call: # 35 times (50µs+0s) by SQL::Translator::Schema::Table::order at line 890, avg 1µs/call
sub SQL::Translator::Schema::Table::CORE:match; # opcode
# spent 190µs within SQL::Translator::Schema::Table::CORE:sort which was called 35 times, avg 5µs/call: # 35 times (190µs+0s) by SQL::Translator::Schema::Table::get_fields at line 537, avg 5µs/call
sub SQL::Translator::Schema::Table::CORE:sort; # opcode