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