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 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
240 | 1 | 1 | 4.66ms | 45.2ms | add_field | SQL::Translator::Schema::Table::
578 | 5 | 4 | 4.53ms | 16.8ms | primary_key (recurses: max depth 1, inclusive time 636µs) | SQL::Translator::Schema::Table::
1124 | 9 | 6 | 3.52ms | 5.12ms | __ANON__[:59] | SQL::Translator::Schema::Table::
778 | 4 | 3 | 2.61ms | 3.87ms | get_field | SQL::Translator::Schema::Table::
853 | 4 | 3 | 2.22ms | 3.50ms | get_constraints | SQL::Translator::Schema::Table::
1263 | 6 | 4 | 2.00ms | 2.08ms | name | SQL::Translator::Schema::Table::
67 | 3 | 2 | 1.79ms | 13.4ms | add_constraint | SQL::Translator::Schema::Table::
1 | 1 | 1 | 1.74ms | 2.79ms | BEGIN@44 | SQL::Translator::Schema::Table::
1 | 1 | 1 | 1.54ms | 1.81ms | BEGIN@43 | SQL::Translator::Schema::Table::
35 | 1 | 1 | 1.00ms | 1.63ms | get_fields | SQL::Translator::Schema::Table::
1 | 1 | 1 | 752µs | 1.07ms | BEGIN@45 | SQL::Translator::Schema::Table::
31 | 3 | 3 | 569µs | 4.05ms | add_index | SQL::Translator::Schema::Table::
35 | 1 | 1 | 451µs | 2.39ms | new | SQL::Translator::Schema::Table::
70 | 2 | 2 | 252µs | 276µs | schema | SQL::Translator::Schema::Table::
66 | 2 | 2 | 245µs | 397µs | get_indices | SQL::Translator::Schema::Table::
70 | 2 | 1 | 209µs | 259µs | order | SQL::Translator::Schema::Table::
35 | 1 | 1 | 190µs | 190µs | CORE:sort (opcode) | SQL::Translator::Schema::Table::
35 | 1 | 1 | 127µs | 127µs | comments | SQL::Translator::Schema::Table::
35 | 1 | 1 | 50µs | 50µs | CORE:match (opcode) | SQL::Translator::Schema::Table::
1 | 1 | 1 | 22µs | 25µs | BEGIN@40 | SQL::Translator::Schema::Table::
1 | 1 | 1 | 12µs | 64µs | BEGIN@58 | SQL::Translator::Schema::Table::
1 | 1 | 1 | 10µs | 36µs | BEGIN@46 | SQL::Translator::Schema::Table::
1 | 1 | 1 | 9µs | 68µs | BEGIN@42 | SQL::Translator::Schema::Table::
1 | 1 | 1 | 8µs | 34µs | BEGIN@41 | SQL::Translator::Schema::Table::
1 | 1 | 1 | 7µs | 59µs | BEGIN@48 | SQL::Translator::Schema::Table::
1 | 1 | 1 | 6µs | 22µs | BEGIN@50 | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | DESTROY | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | __ANON__[:58] | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | can_link | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | data_fields | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | drop_constraint | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | drop_field | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | drop_index | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | equals | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | field_names | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | fkey_constraints | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | fkey_fields | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | is_data | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | is_trivial_link | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | is_valid | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | nonpkey_fields | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | options | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | pkey_fields | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | unique_constraints | SQL::Translator::Schema::Table::
0 | 0 | 0 | 0s | 0s | unique_fields | SQL::Translator::Schema::Table::
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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
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 # spent 1.60ms making 1124 calls to SQL::Translator::Schema::Table::name, avg 1µs/call |
60 | 1 | 10µs | 1 | 52µs | fallback => 1, # spent 52µs making 1 call to overload::import |
61 | 2 | 2.76ms | 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 | ||||
81 | 35 | 23µs | my $class = shift; | ||
82 | 35 | 246µ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 | 35 | 78µs | $self->{_order} = { map { $_ => 0 } qw/ | ||
86 | field | ||||
87 | /}; | ||||
88 | |||||
89 | 35 | 75µs | 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 | ||||
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 | 67 | 23µs | my $self = shift; | ||
116 | 67 | 26µs | my $constraint_class = 'SQL::Translator::Schema::Constraint'; | ||
117 | 67 | 17µs | my $constraint; | ||
118 | |||||
119 | 67 | 261µs | 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 | 67 | 274µs | my %args = @_; | ||
125 | 67 | 55µs | $args{'table'} = $self; | ||
126 | 67 | 180µs | 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 | 67 | 24µs | my $ok = 1; | ||
135 | 67 | 113µs | 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 | 67 | 190µs | 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 | 39 | 168µ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 | 67 | 75µs | if ( $ok ) { | ||
174 | push @{ $self->{'constraints'} }, $constraint; | ||||
175 | } | ||||
176 | |||||
177 | 67 | 152µs | 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 | ||||
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 | 31 | 14µs | my $self = shift; | ||
239 | 31 | 12µs | my $index_class = 'SQL::Translator::Schema::Index'; | ||
240 | 31 | 6µs | my $index; | ||
241 | |||||
242 | 31 | 112µs | 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 | 31 | 80µs | my %args = @_; | ||
248 | 31 | 18µs | $args{'table'} = $self; | ||
249 | 31 | 97µs | 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 | 77µs | 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 | 29µs | 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 | 31 | 29µs | push @{ $self->{'indices'} }, $index; | ||
256 | 31 | 78µs | 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 | ||||
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 | 240 | 69µs | my $self = shift; | ||
323 | 240 | 72µs | my $field_class = 'SQL::Translator::Schema::Field'; | ||
324 | 240 | 35µs | my $field; | ||
325 | |||||
326 | 240 | 928µs | 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 | 240 | 799µs | my %args = @_; | ||
332 | 240 | 201µs | $args{'table'} = $self; | ||
333 | 240 | 734µ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 | 362µs | 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 | 276µs | 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 | 240 | 152µs | if ( exists $self->{'fields'}{ $field_name } ) { | ||
342 | return $self->error(qq[Can't create field: "$field_name" exists]); | ||||
343 | } | ||||
344 | else { | ||||
345 | 240 | 212µs | $self->{'fields'}{ $field_name } = $field; | ||
346 | } | ||||
347 | |||||
348 | 240 | 460µs | 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 | ||||
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 | 35 | 12µs | my $self = shift; | ||
422 | 35 | 17µs | my @comments = ref $_[0] ? @{ $_[0] } : @_; | ||
423 | |||||
424 | 35 | 24µs | for my $arg ( @comments ) { | ||
425 | $arg = $arg->[0] if ref $arg; | ||||
426 | push @{ $self->{'comments'} }, $arg if defined $arg && $arg; | ||||
427 | } | ||||
428 | |||||
429 | 35 | 28µs | if ( @{ $self->{'comments'} || [] } ) { | ||
430 | return wantarray | ||||
431 | ? @{ $self->{'comments'} } | ||||
432 | : join( "\n", @{ $self->{'comments'} } ) | ||||
433 | ; | ||||
434 | } | ||||
435 | else { | ||||
436 | 35 | 80µs | 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 | ||||
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 | 853 | 189µs | my $self = shift; | ||
454 | |||||
455 | 853 | 1.09ms | if ( ref $self->{'constraints'} ) { | ||
456 | return wantarray | ||||
457 | ? @{ $self->{'constraints'} } : $self->{'constraints'}; | ||||
458 | } | ||||
459 | else { | ||||
460 | 458 | 405µs | 458 | 1.28ms | $self->error('No constraints'); # spent 1.28ms making 458 calls to Class::Base::error, avg 3µs/call |
461 | 458 | 768µs | 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 | ||||
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 | 66 | 23µs | my $self = shift; | ||
479 | |||||
480 | 66 | 118µs | if ( ref $self->{'indices'} ) { | ||
481 | return wantarray | ||||
482 | ? @{ $self->{'indices'} } | ||||
483 | : $self->{'indices'}; | ||||
484 | } | ||||
485 | else { | ||||
486 | 35 | 56µs | 35 | 152µs | $self->error('No indices'); # spent 152µs making 35 calls to Class::Base::error, avg 4µs/call |
487 | 35 | 82µs | 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 | ||||
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 | 778 | 176µs | my $self = shift; | ||
505 | 778 | 264µ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 | 778 | 162µs | my $case_insensitive = shift; | ||
507 | 778 | 115µs | 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 | 778 | 1.10ms | 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 | 538 | 1.08ms | 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 | ||||
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 | 35 | 11µs | my $self = shift; | ||
533 | my @fields = | ||||
534 | map { $_->[1] } | ||||
535 | 240 | 378µs | 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 | 534µs | 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 | 35 | 94µs | 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 | ||||
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 | 1263 | 315µs | my $self = shift; | ||
746 | |||||
747 | 1263 | 216µs | if ( @_ ) { | ||
748 | 35 | 20µs | my $arg = shift || return $self->error( "No table name" ); | ||
749 | 35 | 64µs | 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 | 35 | 31µs | $self->{'name'} = $arg; | ||
754 | } | ||||
755 | |||||
756 | 1263 | 2.97ms | 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 | ||||
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 | 70 | 23µs | my $self = shift; | ||
773 | 70 | 31µs | if ( my $arg = shift ) { | ||
774 | 35 | 74µs | 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 | 35 | 66µs | $self->{'schema'} = $arg; | ||
777 | } | ||||
778 | |||||
779 | 70 | 149µs | 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 | ||||
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 | 578 | 139µs | my $self = shift; | ||
810 | 578 | 597µs | 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 | 578 | 86µs | my $constraint; | ||
813 | 578 | 113µs | if ( @$fields ) { | ||
814 | 35 | 29µs | for my $f ( @$fields ) { | ||
815 | 39 | 114µ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 | 35 | 10µs | my $has_pk; | ||
820 | 35 | 65µs | 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 | 90µs | 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 | 578 | 203µs | if ( $constraint ) { | ||
837 | return $constraint; | ||||
838 | } | ||||
839 | else { | ||||
840 | 543 | 787µs | 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 | 1.08ms | 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 | 183 | 328µs | 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 | ||||
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 | 70 | 28µs | my ( $self, $arg ) = @_; | ||
889 | |||||
890 | 70 | 142µs | 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 | 70 | 149µs | 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 | |||||
# 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 |