Profile of SQL/Translator/Schema/Table.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:22:38 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
240 | 1 | 1 | 4.66ms | 45.2ms | SQL::Translator::Schema::Table::::add_fieldSQL::Translator::Schema::Table::add_field
578 | 5 | 4 | 4.53ms | 16.8ms | SQL::Translator::Schema::Table::::primary_keySQL::Translator::Schema::Table::primary_key (recurses: max depth 1, inclusive time 636µs)
1124 | 9 | 6 | 3.52ms | 5.12ms | SQL::Translator::Schema::Table::::__ANON__[:59]SQL::Translator::Schema::Table::__ANON__[:59]
778 | 4 | 3 | 2.61ms | 3.87ms | SQL::Translator::Schema::Table::::get_fieldSQL::Translator::Schema::Table::get_field
853 | 4 | 3 | 2.22ms | 3.50ms | SQL::Translator::Schema::Table::::get_constraintsSQL::Translator::Schema::Table::get_constraints
1263 | 6 | 4 | 2.00ms | 2.08ms | SQL::Translator::Schema::Table::::nameSQL::Translator::Schema::Table::name
67 | 3 | 2 | 1.79ms | 13.4ms | SQL::Translator::Schema::Table::::add_constraintSQL::Translator::Schema::Table::add_constraint
1 | 1 | 1 | 1.74ms | 2.79ms | SQL::Translator::Schema::Table::::BEGIN@44SQL::Translator::Schema::Table::BEGIN@44
1 | 1 | 1 | 1.54ms | 1.81ms | SQL::Translator::Schema::Table::::BEGIN@43SQL::Translator::Schema::Table::BEGIN@43
35 | 1 | 1 | 1.00ms | 1.63ms | SQL::Translator::Schema::Table::::get_fieldsSQL::Translator::Schema::Table::get_fields
1 | 1 | 1 | 752µs | 1.07ms | SQL::Translator::Schema::Table::::BEGIN@45SQL::Translator::Schema::Table::BEGIN@45
31 | 3 | 3 | 569µs | 4.05ms | SQL::Translator::Schema::Table::::add_indexSQL::Translator::Schema::Table::add_index
35 | 1 | 1 | 451µs | 2.39ms | SQL::Translator::Schema::Table::::newSQL::Translator::Schema::Table::new
70 | 2 | 2 | 252µs | 276µs | SQL::Translator::Schema::Table::::schemaSQL::Translator::Schema::Table::schema
66 | 2 | 2 | 245µs | 397µs | SQL::Translator::Schema::Table::::get_indicesSQL::Translator::Schema::Table::get_indices
70 | 2 | 1 | 209µs | 259µs | SQL::Translator::Schema::Table::::orderSQL::Translator::Schema::Table::order
35 | 1 | 1 | 190µs | 190µs | SQL::Translator::Schema::Table::::CORE:sortSQL::Translator::Schema::Table::CORE:sort (opcode)
35 | 1 | 1 | 127µs | 127µs | SQL::Translator::Schema::Table::::commentsSQL::Translator::Schema::Table::comments
35 | 1 | 1 | 50µs | 50µs | SQL::Translator::Schema::Table::::CORE:matchSQL::Translator::Schema::Table::CORE:match (opcode)
1 | 1 | 1 | 22µs | 25µs | SQL::Translator::Schema::Table::::BEGIN@40SQL::Translator::Schema::Table::BEGIN@40
1 | 1 | 1 | 12µs | 64µs | SQL::Translator::Schema::Table::::BEGIN@58SQL::Translator::Schema::Table::BEGIN@58
1 | 1 | 1 | 10µs | 36µs | SQL::Translator::Schema::Table::::BEGIN@46SQL::Translator::Schema::Table::BEGIN@46
1 | 1 | 1 | 9µs | 68µs | SQL::Translator::Schema::Table::::BEGIN@42SQL::Translator::Schema::Table::BEGIN@42
1 | 1 | 1 | 8µs | 34µs | SQL::Translator::Schema::Table::::BEGIN@41SQL::Translator::Schema::Table::BEGIN@41
1 | 1 | 1 | 7µs | 59µs | SQL::Translator::Schema::Table::::BEGIN@48SQL::Translator::Schema::Table::BEGIN@48
1 | 1 | 1 | 6µs | 22µs | SQL::Translator::Schema::Table::::BEGIN@50SQL::Translator::Schema::Table::BEGIN@50
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::DESTROYSQL::Translator::Schema::Table::DESTROY
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::__ANON__[:58]SQL::Translator::Schema::Table::__ANON__[:58]
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::can_linkSQL::Translator::Schema::Table::can_link
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::data_fieldsSQL::Translator::Schema::Table::data_fields
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::drop_constraintSQL::Translator::Schema::Table::drop_constraint
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::drop_fieldSQL::Translator::Schema::Table::drop_field
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::drop_indexSQL::Translator::Schema::Table::drop_index
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::equalsSQL::Translator::Schema::Table::equals
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::field_namesSQL::Translator::Schema::Table::field_names
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::fkey_constraintsSQL::Translator::Schema::Table::fkey_constraints
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::fkey_fieldsSQL::Translator::Schema::Table::fkey_fields
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::is_dataSQL::Translator::Schema::Table::is_data
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::is_trivial_linkSQL::Translator::Schema::Table::is_trivial_link
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::is_validSQL::Translator::Schema::Table::is_valid
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::nonpkey_fieldsSQL::Translator::Schema::Table::nonpkey_fields
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::optionsSQL::Translator::Schema::Table::options
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::pkey_fieldsSQL::Translator::Schema::Table::pkey_fields
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Table::::unique_constraintsSQL::Translator::Schema::Table::unique_constraints
0 | 0 | 0 | 0s | 0s | SQL::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package 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 |  |  |  |  |
25 |  |  |  |  | SQL::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 |  |  |  |  |
34 |  |  |  |  | C<SQL::Translator::Schema::Table> is the table object.
35 |  |  |  |  |
36 |  |  |  |  | =head1 METHODS
37 |  |  |  |  |
38 |  |  |  |  | =cut
39 |  |  |  |  |
40 | 3 | 21µs | 2 | 28µ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
41 | 3 | 20µs | 2 | 61µ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
42 | 3 | 23µs | 2 | 126µ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
43 | 3 | 99µs | 1 | 1.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
44 | 3 | 113µs | 1 | 2.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
45 | 3 | 128µs | 1 | 1.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
46 | 3 | 22µs | 2 | 62µ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 |  |  |  |  |
48 | 3 | 20µs | 2 | 112µ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 |  |  |  |  |
50 | 3 | 61µs | 2 | 38µ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 |  |  |  |  |
52 | 1 | 1µ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!).
57 |  |  |  |  | use 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 },
59 | 1124 | 3.06ms | 1124 | 1.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
60 |  |  | 1 | 52µs | fallback => 1, # spent 52µs making 1 call to overload::import
61 | 3 | 2.77ms | 1 | 64µs | ; # spent 64µs making 1 call to SQL::Translator::Schema::Table::BEGIN@58
62 |  |  |  |  |
63 |  |  |  |  | # ----------------------------------------------------------------------
64 |  |  |  |  |
65 | 1 | 9µs | 1 | 65µ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 |  |  |  |  |
71 |  |  |  |  | Object 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 {
81 | 140 | 401µs |  |  | my $class = shift;
82 | 1 | 20µs | 70 | 1.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 |  |  |  |  |
101 |  |  |  |  | Add a constraint to the table. Returns the newly created
102 |  |  |  |  | C<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 |  |  |  |  |
115 | 843 | 1.50ms |  |  | my $self = shift;
116 |  |  |  |  | my $constraint_class = 'SQL::Translator::Schema::Constraint';
117 |  |  |  |  | my $constraint;
118 |  |  |  |  |
119 |  |  | 67 | 62µ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;
126 |  |  | 67 | 8.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;
135 |  |  | 67 | 550µ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
136 |  |  | 134 | 999µ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 ) {
146 | 1 | 53µs | 117 | 1.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 |  |  |  |  | # ----------------------------------------------------------------------
181 |  |  |  |  | sub drop_constraint {
182 |  |  |  |  |
183 |  |  |  |  | =pod
184 |  |  |  |  |
185 |  |  |  |  | =head2 drop_constraint
186 |  |  |  |  |
187 |  |  |  |  | Remove a constraint from the table. Returns the constraint object if the index
188 |  |  |  |  | was found and removed, an error otherwise. The single parameter can be either
189 |  |  |  |  | an 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 |  |  |  |  |
224 |  |  |  |  | Add an index to the table. Returns the newly created
225 |  |  |  |  | C<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 |  |  |  |  |
238 | 321 | 553µs |  |  | my $self = shift;
239 |  |  |  |  | my $index_class = 'SQL::Translator::Schema::Index';
240 |  |  |  |  | my $index;
241 |  |  |  |  |
242 |  |  | 31 | 25µ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;
249 |  |  | 31 | 2.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 |  |  |  |  | }
252 |  |  | 31 | 226µ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
253 |  |  | 11 | 814µ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 |  |  |  |  | # ----------------------------------------------------------------------
260 |  |  |  |  | sub drop_index {
261 |  |  |  |  |
262 |  |  |  |  | =pod
263 |  |  |  |  |
264 |  |  |  |  | =head2 drop_index
265 |  |  |  |  |
266 |  |  |  |  | Remove an index from the table. Returns the index object if the index was
267 |  |  |  |  | found and removed, an error otherwise. The single parameter can be either
268 |  |  |  |  | an 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 |  |  |  |  |
303 |  |  |  |  | Add an field to the table. Returns the newly created
304 |  |  |  |  | C<SQL::Translator::Schema::Field> object. The "name" parameter is
305 |  |  |  |  | required. If you try to create a field with the same name as an
306 |  |  |  |  | existing 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 |  |  |  |  |
322 | 2880 | 4.17ms |  |  | my $self = shift;
323 |  |  |  |  | my $field_class = 'SQL::Translator::Schema::Field';
324 |  |  |  |  | my $field;
325 |  |  |  |  |
326 |  |  | 240 | 219µ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;
333 | 1 | 127µs | 480 | 38.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 |  |  |  |  |
337 |  |  | 240 | 1.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.
339 |  |  | 240 | 335µs | my $field_name = $field->name; # spent 335µs making 240 calls to SQL::Translator::Schema::Field::name, avg 1µs/call
340 |  |  |  |  |
341 |  |  |  |  | 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 |  |  |  |  | # ----------------------------------------------------------------------
351 |  |  |  |  | sub drop_field {
352 |  |  |  |  |
353 |  |  |  |  | =pod
354 |  |  |  |  |
355 |  |  |  |  | =head2 drop_field
356 |  |  |  |  |
357 |  |  |  |  | Remove a field from the table. Returns the field object if the field was
358 |  |  |  |  | found and removed, an error otherwise. The single parameter can be either
359 |  |  |  |  | a 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 |  |  |  |  |
410 |  |  |  |  | Get or set the comments on a table. May be called several times to
411 |  |  |  |  | set and it will accumulate the comments. Called in an array context,
412 |  |  |  |  | returns each comment individually; called in a scalar context, returns
413 |  |  |  |  | all 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 |  |  |  |  |
421 | 175 | 161µ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 |  |  |  |  |
429 |  |  |  |  | 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 |  |  |  |  |
447 |  |  |  |  | Returns all the constraint objects as an array or array reference.
448 |  |  |  |  |
449 |  |  |  |  | my @constraints = $table->get_constraints;
450 |  |  |  |  |
451 |  |  |  |  | =cut
452 |  |  |  |  |
453 | 2622 | 2.46ms |  |  | my $self = shift;
454 |  |  |  |  |
455 |  |  |  |  | if ( ref $self->{'constraints'} ) {
456 |  |  |  |  | return wantarray
457 |  |  |  |  | ? @{ $self->{'constraints'} } : $self->{'constraints'};
458 |  |  |  |  | }
459 |  |  |  |  | else {
460 |  |  | 458 | 1.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 |  |  |  |  |
472 |  |  |  |  | Returns all the index objects as an array or array reference.
473 |  |  |  |  |
474 |  |  |  |  | my @indices = $table->get_indices;
475 |  |  |  |  |
476 |  |  |  |  | =cut
477 |  |  |  |  |
478 | 202 | 279µs |  |  | my $self = shift;
479 |  |  |  |  |
480 |  |  |  |  | if ( ref $self->{'indices'} ) {
481 |  |  |  |  | return wantarray
482 |  |  |  |  | ? @{ $self->{'indices'} }
483 |  |  |  |  | : $self->{'indices'};
484 |  |  |  |  | }
485 |  |  |  |  | else {
486 |  |  | 35 | 152µ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 |  |  |  |  |
498 |  |  |  |  | Returns a field by the name provided.
499 |  |  |  |  |
500 |  |  |  |  | my $field = $table->get_field('foo');
501 |  |  |  |  |
502 |  |  |  |  | =cut
503 |  |  |  |  |
504 | 4428 | 2.79ms |  |  | my $self = shift;
505 | 1 | 13µs | 39 | 152µ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 |  |  |  |  | }
514 | 1 | 21µs | 279 | 949µ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 };
516 | 1 | 73µs | 39 | 154µ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 |  |  |  |  |
526 |  |  |  |  | Returns all the field objects as an array or array reference.
527 |  |  |  |  |
528 |  |  |  |  | my @fields = $table->get_fields;
529 |  |  |  |  |
530 |  |  |  |  | =cut
531 |  |  |  |  |
532 | 345 | 1.02ms |  |  | my $self = shift;
533 |  |  |  |  | my @fields =
534 |  |  |  |  | map { $_->[1] }
535 |  |  | 240 | 437µ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, $_ ] }
537 |  |  | 35 | 190µ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 |  |  |  |  | # ----------------------------------------------------------------------
549 |  |  |  |  | sub is_valid {
550 |  |  |  |  |
551 |  |  |  |  | =pod
552 |  |  |  |  |
553 |  |  |  |  | =head2 is_valid
554 |  |  |  |  |
555 |  |  |  |  | Determine 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 |  |  |  |  | # ----------------------------------------------------------------------
575 |  |  |  |  | sub is_trivial_link {
576 |  |  |  |  |
577 |  |  |  |  | =pod
578 |  |  |  |  |
579 |  |  |  |  | =head2 is_trivial_link
580 |  |  |  |  |
581 |  |  |  |  | True 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 |  |  |  |  |
609 |  |  |  |  | sub is_data {
610 |  |  |  |  |
611 |  |  |  |  | =pod
612 |  |  |  |  |
613 |  |  |  |  | =head2 is_data
614 |  |  |  |  |
615 |  |  |  |  | Returns 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 |  |  |  |  | # ----------------------------------------------------------------------
635 |  |  |  |  | sub can_link {
636 |  |  |  |  |
637 |  |  |  |  | =pod
638 |  |  |  |  |
639 |  |  |  |  | =head2 can_link
640 |  |  |  |  |
641 |  |  |  |  | Determine 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 |  |  |  |  |
733 |  |  |  |  | Get or set the table's name.
734 |  |  |  |  |
735 |  |  |  |  | Errors ("No table name") if you try to set a blank name.
736 |  |  |  |  |
737 |  |  |  |  | If provided an argument, checks the schema object for a table of
738 |  |  |  |  | that 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 |  |  |  |  |
745 | 3894 | 3.62ms |  |  | my $self = shift;
746 |  |  |  |  |
747 |  |  |  |  | if ( @_ ) {
748 |  |  |  |  | my $arg = shift || return $self->error( "No table name" );
749 |  |  | 35 | 81µ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 |  |  |  |  |
766 |  |  |  |  | Get or set the table's schema object.
767 |  |  |  |  |
768 |  |  |  |  | my $schema = $table->schema;
769 |  |  |  |  |
770 |  |  |  |  | =cut
771 |  |  |  |  |
772 | 280 | 343µs |  |  | my $self = shift;
773 |  |  |  |  | if ( my $arg = shift ) {
774 |  |  | 35 | 23µ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 |  |  |  |  |
789 |  |  |  |  | Gets or sets the table's primary key(s). Takes one or more field
790 |  |  |  |  | names (as a string, list or array[ref]) as an argument. If the field
791 |  |  |  |  | names are present, it will create a new PK if none exists, or it will
792 |  |  |  |  | add to the fields of an existing PK (and will unique the field names).
793 |  |  |  |  | Returns the C<SQL::Translator::Schema::Constraint> object representing
794 |  |  |  |  | the primary key.
795 |  |  |  |  |
796 |  |  |  |  | These 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 |  |  |  |  |
809 | 4155 | 3.62ms |  |  | my $self = shift;
810 |  |  | 578 | 2.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;
813 |  |  |  |  | if ( @$fields ) {
814 |  |  |  |  | for my $f ( @$fields ) {
815 | 1 | 16µs | 78 | 267µ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;
820 |  |  | 35 | 207µ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 |  |  |  |  |
828 |  |  | 35 | 7.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 |  |  |  |  |
836 |  |  |  |  | if ( $constraint ) {
837 |  |  |  |  | return $constraint;
838 |  |  |  |  | }
839 |  |  |  |  | else {
840 |  |  | 543 | 1.78ms | for my $c ( $self->get_constraints ) { # spent 1.78ms making 543 calls to SQL::Translator::Schema::Table::get_constraints, avg 3µs/call
841 |  |  | 360 | 564µ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 |  |  |  |  | # ----------------------------------------------------------------------
849 |  |  |  |  | sub options {
850 |  |  |  |  |
851 |  |  |  |  | =pod
852 |  |  |  |  |
853 |  |  |  |  | =head2 options
854 |  |  |  |  |
855 |  |  |  |  | Get or set the table's options (e.g., table types for MySQL). Returns
856 |  |  |  |  | an 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 |  |  |  |  |
882 |  |  |  |  | Get or set the table's order.
883 |  |  |  |  |
884 |  |  |  |  | my $order = $table->order(3);
885 |  |  |  |  |
886 |  |  |  |  | =cut
887 |  |  |  |  |
888 | 210 | 319µs |  |  | my ( $self, $arg ) = @_;
889 |  |  |  |  |
890 |  |  | 35 | 50µ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 |  |  |  |  | # ----------------------------------------------------------------------
898 |  |  |  |  | sub field_names {
899 |  |  |  |  |
900 |  |  |  |  | =head2 field_names
901 |  |  |  |  |
902 |  |  |  |  | Read-only method to return a list or array ref of the field names. Returns undef
903 |  |  |  |  | or an empty list if the table has no fields set. Useful if you want to
904 |  |  |  |  | avoid 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 |  |  |  |  | # ----------------------------------------------------------------------
926 |  |  |  |  | sub equals {
927 |  |  |  |  |
928 |  |  |  |  | =pod
929 |  |  |  |  |
930 |  |  |  |  | =head2 equals
931 |  |  |  |  |
932 |  |  |  |  | Determines 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;
964 |  |  |  |  | CONSTRAINT:
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
975 |  |  |  |  | CONSTRAINT2:
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;
989 |  |  |  |  | INDEX:
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
1000 |  |  |  |  | INDEX2:
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 |  |  |  |  |
1018 |  |  |  |  | The following are a set of shortcut methods for getting commonly used lists of
1019 |  |  |  |  | fields and constraints. They all return lists or array refs of Field or
1020 |  |  |  |  | Constraint objects.
1021 |  |  |  |  |
1022 |  |  |  |  | =over 4
1023 |  |  |  |  |
1024 |  |  |  |  | =item pkey_fields
1025 |  |  |  |  |
1026 |  |  |  |  | The primary key fields.
1027 |  |  |  |  |
1028 |  |  |  |  | =item fkey_fields
1029 |  |  |  |  |
1030 |  |  |  |  | All foreign key fields.
1031 |  |  |  |  |
1032 |  |  |  |  | =item nonpkey_fields
1033 |  |  |  |  |
1034 |  |  |  |  | All the fields except the primary key.
1035 |  |  |  |  |
1036 |  |  |  |  | =item data_fields
1037 |  |  |  |  |
1038 |  |  |  |  | All non key fields.
1039 |  |  |  |  |
1040 |  |  |  |  | =item unique_fields
1041 |  |  |  |  |
1042 |  |  |  |  | All fields with unique constraints.
1043 |  |  |  |  |
1044 |  |  |  |  | =item unique_constraints
1045 |  |  |  |  |
1046 |  |  |  |  | All this tables unique constraints.
1047 |  |  |  |  |
1048 |  |  |  |  | =item fkey_constraints
1049 |  |  |  |  |
1050 |  |  |  |  | All this tables foreign key constraints. (See primary_key method to get the
1051 |  |  |  |  | primary key constraint)
1052 |  |  |  |  |
1053 |  |  |  |  | =back
1054 |  |  |  |  |
1055 |  |  |  |  | =cut
1056 |  |  |  |  |
1057 |  |  |  |  | sub pkey_fields {
1058 |  |  |  |  | my $me = shift;
1059 |  |  |  |  | my @fields = grep { $_->is_primary_key } $me->get_fields;
1060 |  |  |  |  | return wantarray ? @fields : \@fields;
1061 |  |  |  |  | }
1062 |  |  |  |  |
1063 |  |  |  |  | # ----------------------------------------------------------------------
1064 |  |  |  |  | sub 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 |  |  |  |  | # ----------------------------------------------------------------------
1072 |  |  |  |  | sub nonpkey_fields {
1073 |  |  |  |  | my $me = shift;
1074 |  |  |  |  | my @fields = grep { !$_->is_primary_key } $me->get_fields;
1075 |  |  |  |  | return wantarray ? @fields : \@fields;
1076 |  |  |  |  | }
1077 |  |  |  |  |
1078 |  |  |  |  | # ----------------------------------------------------------------------
1079 |  |  |  |  | sub 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 |  |  |  |  | # ----------------------------------------------------------------------
1087 |  |  |  |  | sub 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 |  |  |  |  | # ----------------------------------------------------------------------
1095 |  |  |  |  | sub unique_constraints {
1096 |  |  |  |  | my $me = shift;
1097 |  |  |  |  | my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
1098 |  |  |  |  | return wantarray ? @cons : \@cons;
1099 |  |  |  |  | }
1100 |  |  |  |  |
1101 |  |  |  |  | # ----------------------------------------------------------------------
1102 |  |  |  |  | sub 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 |  |  |  |  | # ----------------------------------------------------------------------
1109 |  |  |  |  | sub 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 |  |  |  |  |
1117 | 1 | 5µs |  |  | 1;
1118 |  |  |  |  |
1119 |  |  |  |  | # ----------------------------------------------------------------------
1120 |  |  |  |  |
1121 |  |  |  |  | =pod
1122 |  |  |  |  |
1123 |  |  |  |  | =head1 AUTHORS
1124 |  |  |  |  |
1125 |  |  |  |  | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1126 |  |  |  |  | Allen 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