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