| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Index.pm |
| Statements | Executed 1352 statements in 2.18ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 62 | 2 | 2 | 427µs | 852µs | SQL::Translator::Schema::Index::fields |
| 62 | 2 | 2 | 274µs | 447µs | SQL::Translator::Schema::Index::table |
| 11 | 1 | 1 | 213µs | 814µs | SQL::Translator::Schema::Index::equals |
| 106 | 3 | 3 | 207µs | 207µs | SQL::Translator::Schema::Index::name |
| 60 | 2 | 2 | 178µs | 178µs | SQL::Translator::Schema::Index::type |
| 1 | 1 | 1 | 16µs | 21µs | SQL::Translator::Schema::Index::BEGIN@46 |
| 1 | 1 | 1 | 13µs | 84µs | SQL::Translator::Schema::Index::BEGIN@47 |
| 1 | 1 | 1 | 9µs | 84µs | SQL::Translator::Schema::Index::BEGIN@50 |
| 1 | 1 | 1 | 8µs | 55µs | SQL::Translator::Schema::Index::BEGIN@52 |
| 1 | 1 | 1 | 8µs | 30µs | SQL::Translator::Schema::Index::BEGIN@48 |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Index::DESTROY |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Index::is_valid |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Index::options |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package SQL::Translator::Schema::Index; | ||||
| 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::Index - SQL::Translator index object | ||||
| 26 | |||||
| 27 | =head1 SYNOPSIS | ||||
| 28 | |||||
| 29 | use SQL::Translator::Schema::Index; | ||||
| 30 | my $index = SQL::Translator::Schema::Index->new( | ||||
| 31 | name => 'foo', | ||||
| 32 | fields => [ id ], | ||||
| 33 | type => 'unique', | ||||
| 34 | ); | ||||
| 35 | |||||
| 36 | =head1 DESCRIPTION | ||||
| 37 | |||||
| 38 | C<SQL::Translator::Schema::Index> is the index object. | ||||
| 39 | |||||
| 40 | Primary and unique keys are table constraints, not indices. | ||||
| 41 | |||||
| 42 | =head1 METHODS | ||||
| 43 | |||||
| 44 | =cut | ||||
| 45 | |||||
| 46 | 3 | 25µs | 2 | 26µs | # spent 21µs (16+5) within SQL::Translator::Schema::Index::BEGIN@46 which was called:
# once (16µs+5µs) by SQL::Translator::Schema::Table::BEGIN@45 at line 46 # spent 21µs making 1 call to SQL::Translator::Schema::Index::BEGIN@46
# spent 5µs making 1 call to strict::import |
| 47 | 3 | 20µs | 2 | 156µs | # spent 84µs (13+71) within SQL::Translator::Schema::Index::BEGIN@47 which was called:
# once (13µs+71µs) by SQL::Translator::Schema::Table::BEGIN@45 at line 47 # spent 84µs making 1 call to SQL::Translator::Schema::Index::BEGIN@47
# spent 71µs making 1 call to Exporter::import |
| 48 | 3 | 21µs | 2 | 52µs | # spent 30µs (8+22) within SQL::Translator::Schema::Index::BEGIN@48 which was called:
# once (8µs+22µs) by SQL::Translator::Schema::Table::BEGIN@45 at line 48 # spent 30µs making 1 call to SQL::Translator::Schema::Index::BEGIN@48
# spent 22µs making 1 call to Exporter::import |
| 49 | |||||
| 50 | 3 | 25µs | 2 | 160µs | # spent 84µs (9+75) within SQL::Translator::Schema::Index::BEGIN@50 which was called:
# once (9µs+75µs) by SQL::Translator::Schema::Table::BEGIN@45 at line 50 # spent 84µs making 1 call to SQL::Translator::Schema::Index::BEGIN@50
# spent 75µs making 1 call to base::import |
| 51 | |||||
| 52 | 3 | 578µs | 2 | 102µs | # spent 55µs (8+47) within SQL::Translator::Schema::Index::BEGIN@52 which was called:
# once (8µs+47µs) by SQL::Translator::Schema::Table::BEGIN@45 at line 52 # spent 55µs making 1 call to SQL::Translator::Schema::Index::BEGIN@52
# spent 47µs making 1 call to vars::import |
| 53 | |||||
| 54 | 1 | 600ns | $VERSION = '1.59'; | ||
| 55 | |||||
| 56 | 1 | 2µs | my %VALID_INDEX_TYPE = ( | ||
| 57 | UNIQUE => 1, | ||||
| 58 | NORMAL => 1, | ||||
| 59 | FULLTEXT => 1, # MySQL only (?) | ||||
| 60 | FULL_TEXT => 1, # MySQL only (?) | ||||
| 61 | SPATIAL => 1, # MySQL only (?) | ||||
| 62 | ); | ||||
| 63 | |||||
| 64 | # ---------------------------------------------------------------------- | ||||
| 65 | |||||
| 66 | 1 | 4µs | 1 | 46µs | __PACKAGE__->_attributes( qw/ # spent 46µs making 1 call to SQL::Translator::Schema::Object::_attributes |
| 67 | name type fields table options | ||||
| 68 | /); | ||||
| 69 | |||||
| 70 | =pod | ||||
| 71 | |||||
| 72 | =head2 new | ||||
| 73 | |||||
| 74 | Object constructor. | ||||
| 75 | |||||
| 76 | my $schema = SQL::Translator::Schema::Index->new; | ||||
| 77 | |||||
| 78 | =cut | ||||
| 79 | |||||
| 80 | # ---------------------------------------------------------------------- | ||||
| 81 | # spent 852µs (427+425) within SQL::Translator::Schema::Index::fields which was called 62 times, avg 14µs/call:
# 31 times (303µs+298µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 19µs/call
# 31 times (124µs+127µs) by SQL::Translator::Producer::SQLite::create_index at line 345 of SQL/Translator/Producer/SQLite.pm, avg 8µs/call | ||||
| 82 | |||||
| 83 | =pod | ||||
| 84 | |||||
| 85 | =head2 fields | ||||
| 86 | |||||
| 87 | Gets and set the fields the index is on. Accepts a string, list or | ||||
| 88 | arrayref; returns an array or array reference. Will unique the field | ||||
| 89 | names and keep them in order by the first occurrence of a field name. | ||||
| 90 | |||||
| 91 | $index->fields('id'); | ||||
| 92 | $index->fields('id', 'name'); | ||||
| 93 | $index->fields( 'id, name' ); | ||||
| 94 | $index->fields( [ 'id', 'name' ] ); | ||||
| 95 | $index->fields( qw[ id name ] ); | ||||
| 96 | |||||
| 97 | my @fields = $index->fields; | ||||
| 98 | |||||
| 99 | =cut | ||||
| 100 | |||||
| 101 | 434 | 450µs | my $self = shift; | ||
| 102 | 62 | 425µs | my $fields = parse_list_arg( @_ ); # spent 425µs making 62 calls to SQL::Translator::Utils::parse_list_arg, avg 7µs/call | ||
| 103 | |||||
| 104 | if ( @$fields ) { | ||||
| 105 | my ( %unique, @unique ); | ||||
| 106 | for my $f ( @$fields ) { | ||||
| 107 | next if $unique{ $f }; | ||||
| 108 | $unique{ $f } = 1; | ||||
| 109 | push @unique, $f; | ||||
| 110 | } | ||||
| 111 | |||||
| 112 | $self->{'fields'} = \@unique; | ||||
| 113 | } | ||||
| 114 | |||||
| 115 | return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'}; | ||||
| 116 | } | ||||
| 117 | |||||
| 118 | # ---------------------------------------------------------------------- | ||||
| 119 | sub is_valid { | ||||
| 120 | |||||
| 121 | =pod | ||||
| 122 | |||||
| 123 | =head2 is_valid | ||||
| 124 | |||||
| 125 | Determine whether the index is valid or not. | ||||
| 126 | |||||
| 127 | my $ok = $index->is_valid; | ||||
| 128 | |||||
| 129 | =cut | ||||
| 130 | |||||
| 131 | my $self = shift; | ||||
| 132 | my $table = $self->table or return $self->error('No table'); | ||||
| 133 | my @fields = $self->fields or return $self->error('No fields'); | ||||
| 134 | |||||
| 135 | for my $field ( @fields ) { | ||||
| 136 | return $self->error( | ||||
| 137 | "Field '$field' does not exist in table '", $table->name, "'" | ||||
| 138 | ) unless $table->get_field( $field ); | ||||
| 139 | } | ||||
| 140 | |||||
| 141 | return 1; | ||||
| 142 | } | ||||
| 143 | |||||
| 144 | # ---------------------------------------------------------------------- | ||||
| 145 | # spent 207µs within SQL::Translator::Schema::Index::name which was called 106 times, avg 2µs/call:
# 44 times (61µs+0s) by SQL::Translator::Schema::Index::equals at line 264, avg 1µs/call
# 31 times (85µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call
# 31 times (60µs+0s) by SQL::Translator::Producer::SQLite::create_index at line 339 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call | ||||
| 146 | |||||
| 147 | =pod | ||||
| 148 | |||||
| 149 | =head2 name | ||||
| 150 | |||||
| 151 | Get or set the index's name. | ||||
| 152 | |||||
| 153 | my $name = $index->name('foo'); | ||||
| 154 | |||||
| 155 | =cut | ||||
| 156 | |||||
| 157 | 318 | 306µs | my $self = shift; | ||
| 158 | $self->{'name'} = shift if @_; | ||||
| 159 | return $self->{'name'} || ''; | ||||
| 160 | } | ||||
| 161 | |||||
| 162 | # ---------------------------------------------------------------------- | ||||
| 163 | sub options { | ||||
| 164 | |||||
| 165 | =pod | ||||
| 166 | |||||
| 167 | =head2 options | ||||
| 168 | |||||
| 169 | Get or set the index's options (e.g., "using" or "where" for PG). Returns | ||||
| 170 | an array or array reference. | ||||
| 171 | |||||
| 172 | my @options = $index->options; | ||||
| 173 | |||||
| 174 | =cut | ||||
| 175 | |||||
| 176 | my $self = shift; | ||||
| 177 | my $options = parse_list_arg( @_ ); | ||||
| 178 | |||||
| 179 | push @{ $self->{'options'} }, @$options; | ||||
| 180 | |||||
| 181 | if ( ref $self->{'options'} ) { | ||||
| 182 | return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; | ||||
| 183 | } | ||||
| 184 | else { | ||||
| 185 | return wantarray ? () : []; | ||||
| 186 | } | ||||
| 187 | } | ||||
| 188 | |||||
| 189 | # ---------------------------------------------------------------------- | ||||
| 190 | # spent 447µs (274+174) within SQL::Translator::Schema::Index::table which was called 62 times, avg 7µs/call:
# 31 times (229µs+174µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 13µs/call
# 31 times (45µs+0s) by SQL::Translator::Producer::SQLite::create_index at line 346 of SQL/Translator/Producer/SQLite.pm, avg 1µs/call | ||||
| 191 | |||||
| 192 | =pod | ||||
| 193 | |||||
| 194 | =head2 table | ||||
| 195 | |||||
| 196 | Get or set the index's table object. | ||||
| 197 | |||||
| 198 | my $table = $index->table; | ||||
| 199 | |||||
| 200 | =cut | ||||
| 201 | |||||
| 202 | 248 | 312µs | my $self = shift; | ||
| 203 | 1 | 11µs | 31 | 148µs | if ( my $arg = shift ) { # spent 148µs making 31 calls to SQL::Translator::Schema::Table::__ANON__[SQL/Translator/Schema/Table.pm:59], avg 5µs/call |
| 204 | 31 | 26µs | return $self->error('Not a table object') unless # spent 26µs making 31 calls to UNIVERSAL::isa, avg 826ns/call | ||
| 205 | UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' ); | ||||
| 206 | $self->{'table'} = $arg; | ||||
| 207 | } | ||||
| 208 | |||||
| 209 | return $self->{'table'}; | ||||
| 210 | } | ||||
| 211 | |||||
| 212 | # ---------------------------------------------------------------------- | ||||
| 213 | # spent 178µs within SQL::Translator::Schema::Index::type which was called 60 times, avg 3µs/call:
# 31 times (55µs+0s) by SQL::Translator::Producer::SQLite::create_index at line 342 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call
# 29 times (123µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 4µs/call | ||||
| 214 | |||||
| 215 | =pod | ||||
| 216 | |||||
| 217 | =head2 type | ||||
| 218 | |||||
| 219 | Get or set the index's type. | ||||
| 220 | |||||
| 221 | my $type = $index->type('unique'); | ||||
| 222 | |||||
| 223 | Get or set the index's options (e.g., "using" or "where" for PG). Returns | ||||
| 224 | |||||
| 225 | Currently there are only four acceptable types: UNIQUE, NORMAL, FULL_TEXT, | ||||
| 226 | and SPATIAL. The latter two might be MySQL-specific. While both lowercase | ||||
| 227 | and uppercase types are acceptable input, this method returns the type in | ||||
| 228 | uppercase. | ||||
| 229 | |||||
| 230 | =cut | ||||
| 231 | |||||
| 232 | 267 | 241µs | my ( $self, $type ) = @_; | ||
| 233 | |||||
| 234 | if ( $type ) { | ||||
| 235 | $type = uc $type; | ||||
| 236 | return $self->error("Invalid index type: $type") | ||||
| 237 | unless $VALID_INDEX_TYPE{ $type }; | ||||
| 238 | $self->{'type'} = $type; | ||||
| 239 | } | ||||
| 240 | |||||
| 241 | return $self->{'type'} || 'NORMAL'; | ||||
| 242 | } | ||||
| 243 | |||||
| 244 | # ---------------------------------------------------------------------- | ||||
| 245 | # spent 814µs (213+602) within SQL::Translator::Schema::Index::equals which was called 11 times, avg 74µs/call:
# 11 times (213µs+602µs) by SQL::Translator::Schema::Table::add_index at line 253 of SQL/Translator/Schema/Table.pm, avg 74µs/call | ||||
| 246 | |||||
| 247 | =pod | ||||
| 248 | |||||
| 249 | =head2 equals | ||||
| 250 | |||||
| 251 | Determines if this index is the same as another | ||||
| 252 | |||||
| 253 | my $isIdentical = $index1->equals( $index2 ); | ||||
| 254 | |||||
| 255 | =cut | ||||
| 256 | |||||
| 257 | 66 | 181µs | my $self = shift; | ||
| 258 | my $other = shift; | ||||
| 259 | my $case_insensitive = shift; | ||||
| 260 | my $ignore_index_names = shift; | ||||
| 261 | |||||
| 262 | 11 | 540µs | return 0 unless $self->SUPER::equals($other); # spent 540µs making 11 calls to SQL::Translator::Schema::Object::equals, avg 49µs/call | ||
| 263 | |||||
| 264 | 44 | 61µs | unless ($ignore_index_names) { # spent 61µs making 44 calls to SQL::Translator::Schema::Index::name, avg 1µs/call | ||
| 265 | unless ((!$self->name && ($other->name eq $other->fields->[0])) || | ||||
| 266 | (!$other->name && ($self->name eq $self->fields->[0]))) { | ||||
| 267 | return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; | ||||
| 268 | } | ||||
| 269 | } | ||||
| 270 | #return 0 unless $self->is_valid eq $other->is_valid; | ||||
| 271 | return 0 unless $self->type eq $other->type; | ||||
| 272 | |||||
| 273 | # Check fields, regardless of order | ||||
| 274 | my %otherFields = (); # create a hash of the other fields | ||||
| 275 | foreach my $otherField ($other->fields) { | ||||
| 276 | $otherField = uc($otherField) if $case_insensitive; | ||||
| 277 | $otherFields{$otherField} = 1; | ||||
| 278 | } | ||||
| 279 | foreach my $selfField ($self->fields) { # check for self fields in hash | ||||
| 280 | $selfField = uc($selfField) if $case_insensitive; | ||||
| 281 | return 0 unless $otherFields{$selfField}; | ||||
| 282 | delete $otherFields{$selfField}; | ||||
| 283 | } | ||||
| 284 | # Check all other fields were accounted for | ||||
| 285 | return 0 unless keys %otherFields == 0; | ||||
| 286 | |||||
| 287 | return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options); | ||||
| 288 | return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra); | ||||
| 289 | return 1; | ||||
| 290 | } | ||||
| 291 | |||||
| 292 | # ---------------------------------------------------------------------- | ||||
| 293 | sub DESTROY { | ||||
| 294 | my $self = shift; | ||||
| 295 | undef $self->{'table'}; # destroy cyclical reference | ||||
| 296 | } | ||||
| 297 | |||||
| 298 | 1 | 5µs | 1; | ||
| 299 | |||||
| 300 | # ---------------------------------------------------------------------- | ||||
| 301 | |||||
| 302 | =pod | ||||
| 303 | |||||
| 304 | =head1 AUTHOR | ||||
| 305 | |||||
| 306 | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>. | ||||
| 307 | |||||
| 308 | =cut |