| 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 | SQL::Translator::Schema::Constraint::fields |
| 660 | 5 | 3 | 1.31ms | 1.40ms | SQL::Translator::Schema::Constraint::type |
| 530 | 3 | 3 | 1.15ms | 1.53ms | SQL::Translator::Schema::Constraint::table |
| 67 | 1 | 1 | 756µs | 7.55ms | SQL::Translator::Schema::Constraint::init |
| 29 | 1 | 1 | 201µs | 438µs | SQL::Translator::Schema::Constraint::reference_fields |
| 35 | 2 | 2 | 115µs | 115µs | SQL::Translator::Schema::Constraint::name |
| 67 | 1 | 1 | 91µs | 91µs | SQL::Translator::Schema::Constraint::CORE:subst (opcode) |
| 29 | 1 | 1 | 77µs | 77µs | SQL::Translator::Schema::Constraint::reference_table |
| 29 | 1 | 1 | 75µs | 75µs | SQL::Translator::Schema::Constraint::on_update |
| 29 | 1 | 1 | 73µs | 73µs | SQL::Translator::Schema::Constraint::on_delete |
| 1 | 1 | 1 | 12µs | 14µs | SQL::Translator::Schema::Constraint::BEGIN@44 |
| 1 | 1 | 1 | 7µs | 74µs | SQL::Translator::Schema::Constraint::BEGIN@48 |
| 1 | 1 | 1 | 7µs | 60µs | SQL::Translator::Schema::Constraint::BEGIN@45 |
| 1 | 1 | 1 | 7µs | 24µs | SQL::Translator::Schema::Constraint::BEGIN@46 |
| 1 | 1 | 1 | 6µs | 45µs | SQL::Translator::Schema::Constraint::BEGIN@50 |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::DESTROY |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::deferrable |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::equals |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::expression |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::field_names |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::is_valid |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::match_type |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::options |
| 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 | 550 | 743µs | my $self = shift; | ||
| 94 | foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; } | ||||
| 95 | 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 | 3472 | 3.86ms | my $self = shift; | ||
| 238 | 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 | if ( @$fields ) { | ||||
| 241 | my ( %unique, @unique ); | ||||
| 242 | for my $f ( @$fields ) { | ||||
| 243 | next if $unique{ $f }; | ||||
| 244 | $unique{ $f } = 1; | ||||
| 245 | push @unique, $f; | ||||
| 246 | } | ||||
| 247 | |||||
| 248 | $self->{'fields'} = \@unique; | ||||
| 249 | } | ||||
| 250 | |||||
| 251 | 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 | 1 | 217µs | 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 | $self->table->get_field($_) || $_ } @{ $self->{'fields'} }; | ||||
| 256 | 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 | 140 | 149µs | my $self = shift; | ||
| 320 | my $arg = shift || ''; | ||||
| 321 | $self->{'name'} = $arg if $arg; | ||||
| 322 | 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 | 87 | 100µs | my $self = shift; | ||
| 368 | |||||
| 369 | if ( my $arg = shift ) { | ||||
| 370 | # validate $arg? | ||||
| 371 | $self->{'on_delete'} = $arg; | ||||
| 372 | } | ||||
| 373 | |||||
| 374 | return $self->{'on_delete'} || ''; | ||||
| 375 | } | ||||
| 376 | |||||
| 377 | # ---------------------------------------------------------------------- | ||||
| 378 | # spent 75µs within SQL::Translator::Schema::Constraint::on_update which was called 29 times, avg 3µs/call:
# 29 times (75µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call | ||||
| 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 | 87 | 107µs | my $self = shift; | ||
| 391 | |||||
| 392 | if ( my $arg = shift ) { | ||||
| 393 | # validate $arg? | ||||
| 394 | $self->{'on_update'} = $arg; | ||||
| 395 | } | ||||
| 396 | |||||
| 397 | return $self->{'on_update'} || ''; | ||||
| 398 | } | ||||
| 399 | |||||
| 400 | # ---------------------------------------------------------------------- | ||||
| 401 | # spent 438µs (201+237) within SQL::Translator::Schema::Constraint::reference_fields which was called 29 times, avg 15µs/call:
# 29 times (201µs+237µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 15µs/call | ||||
| 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 | 145 | 185µs | my $self = shift; | ||
| 421 | 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 | if ( @$fields ) { | ||||
| 424 | $self->{'reference_fields'} = $fields; | ||||
| 425 | } | ||||
| 426 | |||||
| 427 | # Nothing set so try and derive it from the other constraint data | ||||
| 428 | unless ( ref $self->{'reference_fields'} ) { | ||||
| 429 | my $table = $self->table or return $self->error('No table'); | ||||
| 430 | my $schema = $table->schema or return $self->error('No schema'); | ||||
| 431 | if ( my $ref_table_name = $self->reference_table ) { | ||||
| 432 | my $ref_table = $schema->get_table( $ref_table_name ) or | ||||
| 433 | return $self->error("Can't find table '$ref_table_name'"); | ||||
| 434 | |||||
| 435 | if ( my $constraint = $ref_table->primary_key ) { | ||||
| 436 | $self->{'reference_fields'} = [ $constraint->fields ]; | ||||
| 437 | } | ||||
| 438 | else { | ||||
| 439 | $self->error( | ||||
| 440 | 'No reference fields defined and cannot find primary key in ', | ||||
| 441 | "reference table '$ref_table_name'" | ||||
| 442 | ); | ||||
| 443 | } | ||||
| 444 | } | ||||
| 445 | # No ref table so we are not that sort of constraint, hence no ref | ||||
| 446 | # fields. So we let the return below return an empty list. | ||||
| 447 | } | ||||
| 448 | |||||
| 449 | if ( ref $self->{'reference_fields'} ) { | ||||
| 450 | return wantarray | ||||
| 451 | ? @{ $self->{'reference_fields'} } | ||||
| 452 | : $self->{'reference_fields'}; | ||||
| 453 | } | ||||
| 454 | else { | ||||
| 455 | return wantarray ? () : []; | ||||
| 456 | } | ||||
| 457 | } | ||||
| 458 | |||||
| 459 | # ---------------------------------------------------------------------- | ||||
| 460 | # spent 77µs within SQL::Translator::Schema::Constraint::reference_table which was called 29 times, avg 3µs/call:
# 29 times (77µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call | ||||
| 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 | 87 | 108µs | my $self = shift; | ||
| 473 | $self->{'reference_table'} = shift if @_; | ||||
| 474 | return $self->{'reference_table'} || ''; | ||||
| 475 | } | ||||
| 476 | |||||
| 477 | # ---------------------------------------------------------------------- | ||||
| 478 | # spent 1.53ms (1.15+383µs) within SQL::Translator::Schema::Constraint::table which was called 530 times, avg 3µs/call:
# 460 times (687µs+0s) by SQL::Translator::Schema::Constraint::fields at line 254, avg 1µs/call
# 67 times (460µs+383µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 13µs/call
# 3 times (4µs+0s) by SQL::Translator::Producer::SQLite::create_constraint at line 362 of SQL/Translator/Producer/SQLite.pm, avg 1µs/call | ||||
| 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 | 1724 | 1.52ms | my $self = shift; | ||
| 491 | 1 | 27µ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 | 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 | $self->{'table'} = $arg; | ||||
| 495 | } | ||||
| 496 | |||||
| 497 | return $self->{'table'}; | ||||
| 498 | } | ||||
| 499 | |||||
| 500 | # ---------------------------------------------------------------------- | ||||
| 501 | # spent 1.40ms (1.31+91µs) within SQL::Translator::Schema::Constraint::type which was called 660 times, avg 2µs/call:
# 360 times (564µs+0s) by SQL::Translator::Schema::Table::primary_key at line 841 of SQL/Translator/Schema/Table.pm, avg 2µs/call
# 99 times (144µs+0s) by SQL::Translator::Schema::Table::add_constraint at line 136 of SQL/Translator/Schema/Table.pm, avg 1µs/call
# 67 times (413µs+91µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 8µs/call
# 67 times (103µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 237 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call
# 67 times (88µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 240 of SQL/Translator/Producer/SQLite.pm, avg 1µs/call | ||||
| 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 | 2248 | 2.00ms | my ( $self, $type ) = @_; | ||
| 514 | |||||
| 515 | if ( $type ) { | ||||
| 516 | $type = uc $type; | ||||
| 517 | 67 | 91µs | $type =~ s/_/ /g; # spent 91µs making 67 calls to SQL::Translator::Schema::Constraint::CORE:subst, avg 1µs/call | ||
| 518 | return $self->error("Invalid constraint type: $type") | ||||
| 519 | unless $VALID_CONSTRAINT_TYPE{ $type }; | ||||
| 520 | $self->{'type'} = $type; | ||||
| 521 | } | ||||
| 522 | |||||
| 523 | return $self->{'type'} || ''; | ||||
| 524 | } | ||||
| 525 | |||||
| 526 | # ---------------------------------------------------------------------- | ||||
| 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 |