| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema.pm |
| Statements | Executed 790 statements in 4.29ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 3.05ms | 9.09ms | SQL::Translator::Schema::BEGIN@50 |
| 1 | 1 | 1 | 1.09ms | 1.46ms | SQL::Translator::Schema::BEGIN@51 |
| 4 | 1 | 1 | 848µs | 962µs | SQL::Translator::Schema::get_tables |
| 1 | 1 | 1 | 638µs | 4.45ms | SQL::Translator::Schema::BEGIN@49 |
| 1 | 1 | 1 | 623µs | 830µs | SQL::Translator::Schema::BEGIN@52 |
| 35 | 1 | 1 | 426µs | 900µs | SQL::Translator::Schema::add_table |
| 1 | 1 | 1 | 304µs | 828µs | SQL::Translator::Schema::BEGIN@48 |
| 35 | 1 | 1 | 101µs | 101µs | SQL::Translator::Schema::get_table |
| 4 | 1 | 1 | 86µs | 274µs | SQL::Translator::Schema::new |
| 4 | 1 | 1 | 73µs | 97µs | SQL::Translator::Schema::get_views |
| 2 | 1 | 1 | 56µs | 291µs | SQL::Translator::Schema::add_view |
| 12 | 3 | 1 | 51µs | 51µs | SQL::Translator::Schema::CORE:sort (opcode) |
| 4 | 1 | 1 | 39µs | 56µs | SQL::Translator::Schema::get_triggers |
| 8 | 1 | 1 | 18µs | 18µs | SQL::Translator::Schema::name |
| 1 | 1 | 1 | 12µs | 15µs | SQL::Translator::Schema::BEGIN@47 |
| 4 | 1 | 1 | 12µs | 12µs | SQL::Translator::Schema::translator |
| 1 | 1 | 1 | 7µs | 28µs | SQL::Translator::Schema::BEGIN@54 |
| 1 | 1 | 1 | 7µs | 23µs | SQL::Translator::Schema::BEGIN@57 |
| 1 | 1 | 1 | 7µs | 58µs | SQL::Translator::Schema::BEGIN@56 |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::DESTROY |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::add_procedure |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::add_trigger |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::as_graph |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::as_graph_pm |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::database |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::drop_procedure |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::drop_table |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::drop_trigger |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::drop_view |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::get_procedure |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::get_procedures |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::get_trigger |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::get_view |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::is_valid |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::make_natural_joins |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package SQL::Translator::Schema; | ||||
| 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 - SQL::Translator schema object | ||||
| 26 | |||||
| 27 | =head1 SYNOPSIS | ||||
| 28 | |||||
| 29 | use SQL::Translator::Schema; | ||||
| 30 | my $schema = SQL::Translator::Schema->new( | ||||
| 31 | name => 'Foo', | ||||
| 32 | database => 'MySQL', | ||||
| 33 | ); | ||||
| 34 | my $table = $schema->add_table( name => 'foo' ); | ||||
| 35 | my $view = $schema->add_view( name => 'bar', sql => '...' ); | ||||
| 36 | |||||
| 37 | |||||
| 38 | =head1 DESCSIPTION | ||||
| 39 | |||||
| 40 | C<SQL::Translator::Schema> is the object that accepts, validates, and | ||||
| 41 | returns the database structure. | ||||
| 42 | |||||
| 43 | =head1 METHODS | ||||
| 44 | |||||
| 45 | =cut | ||||
| 46 | |||||
| 47 | 3 | 18µs | 2 | 17µs | # spent 15µs (12+2) within SQL::Translator::Schema::BEGIN@47 which was called:
# once (12µs+2µs) by SQL::Translator::BEGIN@39 at line 47 # spent 15µs making 1 call to SQL::Translator::Schema::BEGIN@47
# spent 2µs making 1 call to strict::import |
| 48 | 3 | 103µs | 2 | 883µs | # spent 828µs (304+524) within SQL::Translator::Schema::BEGIN@48 which was called:
# once (304µs+524µs) by SQL::Translator::BEGIN@39 at line 48 # spent 828µs making 1 call to SQL::Translator::Schema::BEGIN@48
# spent 55µs making 1 call to Exporter::import |
| 49 | 3 | 101µs | 1 | 4.45ms | # spent 4.45ms (638µs+3.82) within SQL::Translator::Schema::BEGIN@49 which was called:
# once (638µs+3.82ms) by SQL::Translator::BEGIN@39 at line 49 # spent 4.45ms making 1 call to SQL::Translator::Schema::BEGIN@49 |
| 50 | 3 | 122µs | 1 | 9.09ms | # spent 9.09ms (3.05+6.04) within SQL::Translator::Schema::BEGIN@50 which was called:
# once (3.05ms+6.04ms) by SQL::Translator::BEGIN@39 at line 50 # spent 9.09ms making 1 call to SQL::Translator::Schema::BEGIN@50 |
| 51 | 3 | 132µs | 1 | 1.46ms | # spent 1.46ms (1.09+368µs) within SQL::Translator::Schema::BEGIN@51 which was called:
# once (1.09ms+368µs) by SQL::Translator::BEGIN@39 at line 51 # spent 1.46ms making 1 call to SQL::Translator::Schema::BEGIN@51 |
| 52 | 3 | 111µs | 1 | 830µs | # spent 830µs (623+207) within SQL::Translator::Schema::BEGIN@52 which was called:
# once (623µs+207µs) by SQL::Translator::BEGIN@39 at line 52 # spent 830µs making 1 call to SQL::Translator::Schema::BEGIN@52 |
| 53 | |||||
| 54 | 3 | 19µs | 2 | 50µs | # spent 28µs (7+21) within SQL::Translator::Schema::BEGIN@54 which was called:
# once (7µs+21µs) by SQL::Translator::BEGIN@39 at line 54 # spent 28µs making 1 call to SQL::Translator::Schema::BEGIN@54
# spent 21µs making 1 call to Exporter::import |
| 55 | |||||
| 56 | 3 | 20µs | 2 | 110µs | # spent 58µs (7+52) within SQL::Translator::Schema::BEGIN@56 which was called:
# once (7µs+52µs) by SQL::Translator::BEGIN@39 at line 56 # spent 58µs making 1 call to SQL::Translator::Schema::BEGIN@56
# spent 52µs making 1 call to base::import |
| 57 | 3 | 1.96ms | 2 | 38µs | # spent 23µs (7+16) within SQL::Translator::Schema::BEGIN@57 which was called:
# once (7µs+16µs) by SQL::Translator::BEGIN@39 at line 57 # spent 23µs making 1 call to SQL::Translator::Schema::BEGIN@57
# spent 16µs making 1 call to vars::import |
| 58 | |||||
| 59 | 1 | 800ns | $VERSION = '1.59'; | ||
| 60 | |||||
| 61 | 1 | 8µs | 1 | 57µs | __PACKAGE__->_attributes(qw/name database translator/); # spent 57µs making 1 call to SQL::Translator::Schema::Object::_attributes |
| 62 | |||||
| 63 | # spent 274µs (86+188) within SQL::Translator::Schema::new which was called 4 times, avg 69µs/call:
# 4 times (86µs+188µs) by SQL::Translator::schema at line 377 of SQL/Translator.pm, avg 69µs/call | ||||
| 64 | 16 | 88µs | my $class = shift; | ||
| 65 | 4 | 188µs | my $self = $class->SUPER::new (@_) # spent 188µs making 4 calls to Class::Base::new, avg 47µs/call | ||
| 66 | or return; | ||||
| 67 | |||||
| 68 | $self->{_order} = { map { $_ => 0 } qw/ | ||||
| 69 | table | ||||
| 70 | view | ||||
| 71 | trigger | ||||
| 72 | proc | ||||
| 73 | /}; | ||||
| 74 | |||||
| 75 | return $self; | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | # ---------------------------------------------------------------------- | ||||
| 79 | sub as_graph { | ||||
| 80 | |||||
| 81 | =pod | ||||
| 82 | |||||
| 83 | =head2 as_graph | ||||
| 84 | |||||
| 85 | Returns the schema as an L<SQL::Translator::Schema::Graph> object. | ||||
| 86 | |||||
| 87 | =cut | ||||
| 88 | require SQL::Translator::Schema::Graph; | ||||
| 89 | |||||
| 90 | my $self = shift; | ||||
| 91 | |||||
| 92 | return SQL::Translator::Schema::Graph->new( | ||||
| 93 | translator => $self->translator ); | ||||
| 94 | } | ||||
| 95 | |||||
| 96 | # ---------------------------------------------------------------------- | ||||
| 97 | sub as_graph_pm { | ||||
| 98 | |||||
| 99 | =pod | ||||
| 100 | |||||
| 101 | =head2 as_graph_pm | ||||
| 102 | |||||
| 103 | Returns a Graph::Directed object with the table names for nodes. | ||||
| 104 | |||||
| 105 | =cut | ||||
| 106 | |||||
| 107 | require Graph::Directed; | ||||
| 108 | |||||
| 109 | my $self = shift; | ||||
| 110 | my $g = Graph::Directed->new; | ||||
| 111 | |||||
| 112 | for my $table ( $self->get_tables ) { | ||||
| 113 | my $tname = $table->name; | ||||
| 114 | $g->add_vertex( $tname ); | ||||
| 115 | |||||
| 116 | for my $field ( $table->get_fields ) { | ||||
| 117 | if ( $field->is_foreign_key ) { | ||||
| 118 | my $fktable = $field->foreign_key_reference->reference_table; | ||||
| 119 | |||||
| 120 | $g->add_edge( $fktable, $tname ); | ||||
| 121 | } | ||||
| 122 | } | ||||
| 123 | } | ||||
| 124 | |||||
| 125 | return $g; | ||||
| 126 | } | ||||
| 127 | |||||
| 128 | # ---------------------------------------------------------------------- | ||||
| 129 | # spent 900µs (426+474) within SQL::Translator::Schema::add_table which was called 35 times, avg 26µs/call:
# 35 times (426µs+474µs) by SQL::Translator::Parser::DBIx::Class::parse at line 283 of SQL/Translator/Parser/DBIx/Class.pm, avg 26µs/call | ||||
| 130 | |||||
| 131 | =pod | ||||
| 132 | |||||
| 133 | =head2 add_table | ||||
| 134 | |||||
| 135 | Add a table object. Returns the new SQL::Translator::Schema::Table object. | ||||
| 136 | The "name" parameter is required. If you try to create a table with the | ||||
| 137 | same name as an existing table, you will get an error and the table will | ||||
| 138 | not be created. | ||||
| 139 | |||||
| 140 | my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error; | ||||
| 141 | my $t2 = SQL::Translator::Schema::Table->new( name => 'bar' ); | ||||
| 142 | $t2 = $schema->add_table( $table_bar ) or die $schema->error; | ||||
| 143 | |||||
| 144 | =cut | ||||
| 145 | |||||
| 146 | 385 | 389µs | my $self = shift; | ||
| 147 | my $table_class = 'SQL::Translator::Schema::Table'; | ||||
| 148 | my $table; | ||||
| 149 | |||||
| 150 | 35 | 30µs | if ( UNIVERSAL::isa( $_[0], $table_class ) ) { # spent 30µs making 35 calls to UNIVERSAL::isa, avg 866ns/call | ||
| 151 | $table = shift; | ||||
| 152 | 35 | 194µs | $table->schema($self); # spent 194µs making 35 calls to SQL::Translator::Schema::Table::schema, avg 6µs/call | ||
| 153 | } | ||||
| 154 | else { | ||||
| 155 | my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; | ||||
| 156 | $args{'schema'} = $self; | ||||
| 157 | $table = $table_class->new( \%args ) | ||||
| 158 | or return $self->error( $table_class->error ); | ||||
| 159 | } | ||||
| 160 | |||||
| 161 | 35 | 189µs | $table->order( ++$self->{_order}{table} ); # spent 189µs making 35 calls to SQL::Translator::Schema::Table::order, avg 5µs/call | ||
| 162 | |||||
| 163 | # We know we have a name as the Table->new above errors if none given. | ||||
| 164 | 35 | 60µs | my $table_name = $table->name; # spent 60µs making 35 calls to SQL::Translator::Schema::Table::name, avg 2µs/call | ||
| 165 | |||||
| 166 | if ( defined $self->{'tables'}{$table_name} ) { | ||||
| 167 | return $self->error(qq[Can't create table: "$table_name" exists]); | ||||
| 168 | } | ||||
| 169 | else { | ||||
| 170 | $self->{'tables'}{$table_name} = $table; | ||||
| 171 | } | ||||
| 172 | |||||
| 173 | return $table; | ||||
| 174 | } | ||||
| 175 | |||||
| 176 | # ---------------------------------------------------------------------- | ||||
| 177 | sub drop_table { | ||||
| 178 | |||||
| 179 | =pod | ||||
| 180 | |||||
| 181 | =head2 drop_table | ||||
| 182 | |||||
| 183 | Remove a table from the schema. Returns the table object if the table was found | ||||
| 184 | and removed, an error otherwise. The single parameter can be either a table | ||||
| 185 | name or an C<SQL::Translator::Schema::Table> object. The "cascade" parameter | ||||
| 186 | can be set to 1 to also drop all triggers on the table, default is 0. | ||||
| 187 | |||||
| 188 | $schema->drop_table('mytable'); | ||||
| 189 | $schema->drop_table('mytable', cascade => 1); | ||||
| 190 | |||||
| 191 | =cut | ||||
| 192 | |||||
| 193 | my $self = shift; | ||||
| 194 | my $table_class = 'SQL::Translator::Schema::Table'; | ||||
| 195 | my $table_name; | ||||
| 196 | |||||
| 197 | if ( UNIVERSAL::isa( $_[0], $table_class ) ) { | ||||
| 198 | $table_name = shift->name; | ||||
| 199 | } | ||||
| 200 | else { | ||||
| 201 | $table_name = shift; | ||||
| 202 | } | ||||
| 203 | my %args = @_; | ||||
| 204 | my $cascade = $args{'cascade'}; | ||||
| 205 | |||||
| 206 | if ( !exists $self->{'tables'}{$table_name} ) { | ||||
| 207 | return $self->error(qq[Can't drop table: $table_name" doesn't exist]); | ||||
| 208 | } | ||||
| 209 | |||||
| 210 | my $table = delete $self->{'tables'}{$table_name}; | ||||
| 211 | |||||
| 212 | if ($cascade) { | ||||
| 213 | |||||
| 214 | # Drop all triggers on this table | ||||
| 215 | $self->drop_trigger() | ||||
| 216 | for ( grep { $_->on_table eq $table_name } @{ $self->{'triggers'} } ); | ||||
| 217 | } | ||||
| 218 | return $table; | ||||
| 219 | } | ||||
| 220 | |||||
| 221 | # ---------------------------------------------------------------------- | ||||
| 222 | sub add_procedure { | ||||
| 223 | |||||
| 224 | =pod | ||||
| 225 | |||||
| 226 | =head2 add_procedure | ||||
| 227 | |||||
| 228 | Add a procedure object. Returns the new SQL::Translator::Schema::Procedure | ||||
| 229 | object. The "name" parameter is required. If you try to create a procedure | ||||
| 230 | with the same name as an existing procedure, you will get an error and the | ||||
| 231 | procedure will not be created. | ||||
| 232 | |||||
| 233 | my $p1 = $schema->add_procedure( name => 'foo' ); | ||||
| 234 | my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' ); | ||||
| 235 | $p2 = $schema->add_procedure( $procedure_bar ) or die $schema->error; | ||||
| 236 | |||||
| 237 | =cut | ||||
| 238 | |||||
| 239 | my $self = shift; | ||||
| 240 | my $procedure_class = 'SQL::Translator::Schema::Procedure'; | ||||
| 241 | my $procedure; | ||||
| 242 | |||||
| 243 | if ( UNIVERSAL::isa( $_[0], $procedure_class ) ) { | ||||
| 244 | $procedure = shift; | ||||
| 245 | $procedure->schema($self); | ||||
| 246 | } | ||||
| 247 | else { | ||||
| 248 | my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; | ||||
| 249 | $args{'schema'} = $self; | ||||
| 250 | return $self->error('No procedure name') unless $args{'name'}; | ||||
| 251 | $procedure = $procedure_class->new( \%args ) | ||||
| 252 | or return $self->error( $procedure_class->error ); | ||||
| 253 | } | ||||
| 254 | |||||
| 255 | $procedure->order( ++$self->{_order}{proc} ); | ||||
| 256 | my $procedure_name = $procedure->name | ||||
| 257 | or return $self->error('No procedure name'); | ||||
| 258 | |||||
| 259 | if ( defined $self->{'procedures'}{$procedure_name} ) { | ||||
| 260 | return $self->error( | ||||
| 261 | qq[Can't create procedure: "$procedure_name" exists] ); | ||||
| 262 | } | ||||
| 263 | else { | ||||
| 264 | $self->{'procedures'}{$procedure_name} = $procedure; | ||||
| 265 | } | ||||
| 266 | |||||
| 267 | return $procedure; | ||||
| 268 | } | ||||
| 269 | |||||
| 270 | # ---------------------------------------------------------------------- | ||||
| 271 | sub drop_procedure { | ||||
| 272 | |||||
| 273 | =pod | ||||
| 274 | |||||
| 275 | =head2 drop_procedure | ||||
| 276 | |||||
| 277 | Remove a procedure from the schema. Returns the procedure object if the | ||||
| 278 | procedure was found and removed, an error otherwise. The single parameter | ||||
| 279 | can be either a procedure name or an C<SQL::Translator::Schema::Procedure> | ||||
| 280 | object. | ||||
| 281 | |||||
| 282 | $schema->drop_procedure('myprocedure'); | ||||
| 283 | |||||
| 284 | =cut | ||||
| 285 | |||||
| 286 | my $self = shift; | ||||
| 287 | my $proc_class = 'SQL::Translator::Schema::Procedure'; | ||||
| 288 | my $proc_name; | ||||
| 289 | |||||
| 290 | if ( UNIVERSAL::isa( $_[0], $proc_class ) ) { | ||||
| 291 | $proc_name = shift->name; | ||||
| 292 | } | ||||
| 293 | else { | ||||
| 294 | $proc_name = shift; | ||||
| 295 | } | ||||
| 296 | |||||
| 297 | if ( !exists $self->{'procedures'}{$proc_name} ) { | ||||
| 298 | return $self->error( | ||||
| 299 | qq[Can't drop procedure: $proc_name" doesn't exist]); | ||||
| 300 | } | ||||
| 301 | |||||
| 302 | my $proc = delete $self->{'procedures'}{$proc_name}; | ||||
| 303 | |||||
| 304 | return $proc; | ||||
| 305 | } | ||||
| 306 | |||||
| 307 | # ---------------------------------------------------------------------- | ||||
| 308 | sub add_trigger { | ||||
| 309 | |||||
| 310 | =pod | ||||
| 311 | |||||
| 312 | =head2 add_trigger | ||||
| 313 | |||||
| 314 | Add a trigger object. Returns the new SQL::Translator::Schema::Trigger object. | ||||
| 315 | The "name" parameter is required. If you try to create a trigger with the | ||||
| 316 | same name as an existing trigger, you will get an error and the trigger will | ||||
| 317 | not be created. | ||||
| 318 | |||||
| 319 | my $t1 = $schema->add_trigger( name => 'foo' ); | ||||
| 320 | my $t2 = SQL::Translator::Schema::Trigger->new( name => 'bar' ); | ||||
| 321 | $t2 = $schema->add_trigger( $trigger_bar ) or die $schema->error; | ||||
| 322 | |||||
| 323 | =cut | ||||
| 324 | |||||
| 325 | my $self = shift; | ||||
| 326 | my $trigger_class = 'SQL::Translator::Schema::Trigger'; | ||||
| 327 | my $trigger; | ||||
| 328 | |||||
| 329 | if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) { | ||||
| 330 | $trigger = shift; | ||||
| 331 | $trigger->schema($self); | ||||
| 332 | } | ||||
| 333 | else { | ||||
| 334 | my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; | ||||
| 335 | $args{'schema'} = $self; | ||||
| 336 | return $self->error('No trigger name') unless $args{'name'}; | ||||
| 337 | $trigger = $trigger_class->new( \%args ) | ||||
| 338 | or return $self->error( $trigger_class->error ); | ||||
| 339 | } | ||||
| 340 | |||||
| 341 | $trigger->order( ++$self->{_order}{trigger} ); | ||||
| 342 | |||||
| 343 | my $trigger_name = $trigger->name or return $self->error('No trigger name'); | ||||
| 344 | if ( defined $self->{'triggers'}{$trigger_name} ) { | ||||
| 345 | return $self->error(qq[Can't create trigger: "$trigger_name" exists]); | ||||
| 346 | } | ||||
| 347 | else { | ||||
| 348 | $self->{'triggers'}{$trigger_name} = $trigger; | ||||
| 349 | } | ||||
| 350 | |||||
| 351 | return $trigger; | ||||
| 352 | } | ||||
| 353 | |||||
| 354 | # ---------------------------------------------------------------------- | ||||
| 355 | sub drop_trigger { | ||||
| 356 | |||||
| 357 | =pod | ||||
| 358 | |||||
| 359 | =head2 drop_trigger | ||||
| 360 | |||||
| 361 | Remove a trigger from the schema. Returns the trigger object if the trigger was | ||||
| 362 | found and removed, an error otherwise. The single parameter can be either a | ||||
| 363 | trigger name or an C<SQL::Translator::Schema::Trigger> object. | ||||
| 364 | |||||
| 365 | $schema->drop_trigger('mytrigger'); | ||||
| 366 | |||||
| 367 | =cut | ||||
| 368 | |||||
| 369 | my $self = shift; | ||||
| 370 | my $trigger_class = 'SQL::Translator::Schema::Trigger'; | ||||
| 371 | my $trigger_name; | ||||
| 372 | |||||
| 373 | if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) { | ||||
| 374 | $trigger_name = shift->name; | ||||
| 375 | } | ||||
| 376 | else { | ||||
| 377 | $trigger_name = shift; | ||||
| 378 | } | ||||
| 379 | |||||
| 380 | if ( !exists $self->{'triggers'}{$trigger_name} ) { | ||||
| 381 | return $self->error( | ||||
| 382 | qq[Can't drop trigger: $trigger_name" doesn't exist]); | ||||
| 383 | } | ||||
| 384 | |||||
| 385 | my $trigger = delete $self->{'triggers'}{$trigger_name}; | ||||
| 386 | |||||
| 387 | return $trigger; | ||||
| 388 | } | ||||
| 389 | |||||
| 390 | # ---------------------------------------------------------------------- | ||||
| 391 | # spent 291µs (56+235) within SQL::Translator::Schema::add_view which was called 2 times, avg 146µs/call:
# 2 times (56µs+235µs) by SQL::Translator::Parser::DBIx::Class::parse at line 337 of SQL/Translator/Parser/DBIx/Class.pm, avg 146µs/call | ||||
| 392 | |||||
| 393 | =pod | ||||
| 394 | |||||
| 395 | =head2 add_view | ||||
| 396 | |||||
| 397 | Add a view object. Returns the new SQL::Translator::Schema::View object. | ||||
| 398 | The "name" parameter is required. If you try to create a view with the | ||||
| 399 | same name as an existing view, you will get an error and the view will | ||||
| 400 | not be created. | ||||
| 401 | |||||
| 402 | my $v1 = $schema->add_view( name => 'foo' ); | ||||
| 403 | my $v2 = SQL::Translator::Schema::View->new( name => 'bar' ); | ||||
| 404 | $v2 = $schema->add_view( $view_bar ) or die $schema->error; | ||||
| 405 | |||||
| 406 | =cut | ||||
| 407 | |||||
| 408 | 26 | 52µs | my $self = shift; | ||
| 409 | my $view_class = 'SQL::Translator::Schema::View'; | ||||
| 410 | my $view; | ||||
| 411 | |||||
| 412 | 2 | 2µs | if ( UNIVERSAL::isa( $_[0], $view_class ) ) { # spent 2µs making 2 calls to UNIVERSAL::isa, avg 850ns/call | ||
| 413 | $view = shift; | ||||
| 414 | $view->schema($self); | ||||
| 415 | } | ||||
| 416 | else { | ||||
| 417 | my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_; | ||||
| 418 | $args{'schema'} = $self; | ||||
| 419 | return $self->error('No view name') unless $args{'name'}; | ||||
| 420 | 2 | 215µs | $view = $view_class->new( \%args ) or return $view_class->error; # spent 215µs making 2 calls to Class::Base::new, avg 107µs/call | ||
| 421 | } | ||||
| 422 | |||||
| 423 | 2 | 16µs | $view->order( ++$self->{_order}{view} ); # spent 16µs making 2 calls to SQL::Translator::Schema::View::order, avg 8µs/call | ||
| 424 | 2 | 3µs | my $view_name = $view->name or return $self->error('No view name'); # spent 3µs making 2 calls to SQL::Translator::Schema::View::name, avg 2µs/call | ||
| 425 | |||||
| 426 | if ( defined $self->{'views'}{$view_name} ) { | ||||
| 427 | return $self->error(qq[Can't create view: "$view_name" exists]); | ||||
| 428 | } | ||||
| 429 | else { | ||||
| 430 | $self->{'views'}{$view_name} = $view; | ||||
| 431 | } | ||||
| 432 | |||||
| 433 | return $view; | ||||
| 434 | } | ||||
| 435 | |||||
| 436 | # ---------------------------------------------------------------------- | ||||
| 437 | sub drop_view { | ||||
| 438 | |||||
| 439 | =pod | ||||
| 440 | |||||
| 441 | =head2 drop_view | ||||
| 442 | |||||
| 443 | Remove a view from the schema. Returns the view object if the view was found | ||||
| 444 | and removed, an error otherwise. The single parameter can be either a view | ||||
| 445 | name or an C<SQL::Translator::Schema::View> object. | ||||
| 446 | |||||
| 447 | $schema->drop_view('myview'); | ||||
| 448 | |||||
| 449 | =cut | ||||
| 450 | |||||
| 451 | my $self = shift; | ||||
| 452 | my $view_class = 'SQL::Translator::Schema::View'; | ||||
| 453 | my $view_name; | ||||
| 454 | |||||
| 455 | if ( UNIVERSAL::isa( $_[0], $view_class ) ) { | ||||
| 456 | $view_name = shift->name; | ||||
| 457 | } | ||||
| 458 | else { | ||||
| 459 | $view_name = shift; | ||||
| 460 | } | ||||
| 461 | |||||
| 462 | if ( !exists $self->{'views'}{$view_name} ) { | ||||
| 463 | return $self->error(qq[Can't drop view: $view_name" doesn't exist]); | ||||
| 464 | } | ||||
| 465 | |||||
| 466 | my $view = delete $self->{'views'}{$view_name}; | ||||
| 467 | |||||
| 468 | return $view; | ||||
| 469 | } | ||||
| 470 | |||||
| 471 | # ---------------------------------------------------------------------- | ||||
| 472 | sub database { | ||||
| 473 | |||||
| 474 | =pod | ||||
| 475 | |||||
| 476 | =head2 database | ||||
| 477 | |||||
| 478 | Get or set the schema's database. (optional) | ||||
| 479 | |||||
| 480 | my $database = $schema->database('PostgreSQL'); | ||||
| 481 | |||||
| 482 | =cut | ||||
| 483 | |||||
| 484 | my $self = shift; | ||||
| 485 | $self->{'database'} = shift if @_; | ||||
| 486 | return $self->{'database'} || ''; | ||||
| 487 | } | ||||
| 488 | |||||
| 489 | # ---------------------------------------------------------------------- | ||||
| 490 | sub is_valid { | ||||
| 491 | |||||
| 492 | =pod | ||||
| 493 | |||||
| 494 | =head2 is_valid | ||||
| 495 | |||||
| 496 | Returns true if all the tables and views are valid. | ||||
| 497 | |||||
| 498 | my $ok = $schema->is_valid or die $schema->error; | ||||
| 499 | |||||
| 500 | =cut | ||||
| 501 | |||||
| 502 | my $self = shift; | ||||
| 503 | |||||
| 504 | return $self->error('No tables') unless $self->get_tables; | ||||
| 505 | |||||
| 506 | for my $object ( $self->get_tables, $self->get_views ) { | ||||
| 507 | return $object->error unless $object->is_valid; | ||||
| 508 | } | ||||
| 509 | |||||
| 510 | return 1; | ||||
| 511 | } | ||||
| 512 | |||||
| 513 | # ---------------------------------------------------------------------- | ||||
| 514 | sub get_procedure { | ||||
| 515 | |||||
| 516 | =pod | ||||
| 517 | |||||
| 518 | =head2 get_procedure | ||||
| 519 | |||||
| 520 | Returns a procedure by the name provided. | ||||
| 521 | |||||
| 522 | my $procedure = $schema->get_procedure('foo'); | ||||
| 523 | |||||
| 524 | =cut | ||||
| 525 | |||||
| 526 | my $self = shift; | ||||
| 527 | my $procedure_name = shift or return $self->error('No procedure name'); | ||||
| 528 | return $self->error(qq[Table "$procedure_name" does not exist]) | ||||
| 529 | unless exists $self->{'procedures'}{$procedure_name}; | ||||
| 530 | return $self->{'procedures'}{$procedure_name}; | ||||
| 531 | } | ||||
| 532 | |||||
| 533 | # ---------------------------------------------------------------------- | ||||
| 534 | sub get_procedures { | ||||
| 535 | |||||
| 536 | =pod | ||||
| 537 | |||||
| 538 | =head2 get_procedures | ||||
| 539 | |||||
| 540 | Returns all the procedures as an array or array reference. | ||||
| 541 | |||||
| 542 | my @procedures = $schema->get_procedures; | ||||
| 543 | |||||
| 544 | =cut | ||||
| 545 | |||||
| 546 | my $self = shift; | ||||
| 547 | my @procedures = | ||||
| 548 | map { $_->[1] } | ||||
| 549 | sort { $a->[0] <=> $b->[0] } | ||||
| 550 | map { [ $_->order, $_ ] } values %{ $self->{'procedures'} }; | ||||
| 551 | |||||
| 552 | if (@procedures) { | ||||
| 553 | return wantarray ? @procedures : \@procedures; | ||||
| 554 | } | ||||
| 555 | else { | ||||
| 556 | $self->error('No procedures'); | ||||
| 557 | return wantarray ? () : undef; | ||||
| 558 | } | ||||
| 559 | } | ||||
| 560 | |||||
| 561 | # ---------------------------------------------------------------------- | ||||
| 562 | # spent 101µs within SQL::Translator::Schema::get_table which was called 35 times, avg 3µs/call:
# 35 times (101µs+0s) by SQL::Translator::Parser::DBIx::Class::parse at line 287 of SQL/Translator/Parser/DBIx/Class.pm, avg 3µs/call | ||||
| 563 | |||||
| 564 | =pod | ||||
| 565 | |||||
| 566 | =head2 get_table | ||||
| 567 | |||||
| 568 | Returns a table by the name provided. | ||||
| 569 | |||||
| 570 | my $table = $schema->get_table('foo'); | ||||
| 571 | |||||
| 572 | =cut | ||||
| 573 | |||||
| 574 | 210 | 132µs | my $self = shift; | ||
| 575 | my $table_name = shift or return $self->error('No table name'); | ||||
| 576 | my $case_insensitive = shift; | ||||
| 577 | if ( $case_insensitive ) { | ||||
| 578 | $table_name = uc($table_name); | ||||
| 579 | foreach my $table ( keys %{$self->{tables}} ) { | ||||
| 580 | return $self->{tables}{$table} if $table_name eq uc($table); | ||||
| 581 | } | ||||
| 582 | return $self->error(qq[Table "$table_name" does not exist]); | ||||
| 583 | } | ||||
| 584 | return $self->error(qq[Table "$table_name" does not exist]) | ||||
| 585 | unless exists $self->{'tables'}{$table_name}; | ||||
| 586 | return $self->{'tables'}{$table_name}; | ||||
| 587 | } | ||||
| 588 | |||||
| 589 | # ---------------------------------------------------------------------- | ||||
| 590 | # spent 962µs (848+114) within SQL::Translator::Schema::get_tables which was called 4 times, avg 240µs/call:
# 4 times (848µs+114µs) by SQL::Translator::Producer::SQLite::produce at line 77 of SQL/Translator/Producer/SQLite.pm, avg 240µs/call | ||||
| 591 | |||||
| 592 | =pod | ||||
| 593 | |||||
| 594 | =head2 get_tables | ||||
| 595 | |||||
| 596 | Returns all the tables as an array or array reference. | ||||
| 597 | |||||
| 598 | my @tables = $schema->get_tables; | ||||
| 599 | |||||
| 600 | =cut | ||||
| 601 | |||||
| 602 | 47 | 866µs | my $self = shift; | ||
| 603 | my @tables = | ||||
| 604 | map { $_->[1] } | ||||
| 605 | 35 | 70µs | sort { $a->[0] <=> $b->[0] } # spent 70µs making 35 calls to SQL::Translator::Schema::Table::order, avg 2µs/call | ||
| 606 | 4 | 44µs | map { [ $_->order, $_ ] } values %{ $self->{'tables'} }; # spent 44µs making 4 calls to SQL::Translator::Schema::CORE:sort, avg 11µs/call | ||
| 607 | |||||
| 608 | if (@tables) { | ||||
| 609 | return wantarray ? @tables : \@tables; | ||||
| 610 | } | ||||
| 611 | else { | ||||
| 612 | $self->error('No tables'); | ||||
| 613 | return wantarray ? () : undef; | ||||
| 614 | } | ||||
| 615 | } | ||||
| 616 | |||||
| 617 | # ---------------------------------------------------------------------- | ||||
| 618 | sub get_trigger { | ||||
| 619 | |||||
| 620 | =pod | ||||
| 621 | |||||
| 622 | =head2 get_trigger | ||||
| 623 | |||||
| 624 | Returns a trigger by the name provided. | ||||
| 625 | |||||
| 626 | my $trigger = $schema->get_trigger('foo'); | ||||
| 627 | |||||
| 628 | =cut | ||||
| 629 | |||||
| 630 | my $self = shift; | ||||
| 631 | my $trigger_name = shift or return $self->error('No trigger name'); | ||||
| 632 | return $self->error(qq[Table "$trigger_name" does not exist]) | ||||
| 633 | unless exists $self->{'triggers'}{$trigger_name}; | ||||
| 634 | return $self->{'triggers'}{$trigger_name}; | ||||
| 635 | } | ||||
| 636 | |||||
| 637 | # ---------------------------------------------------------------------- | ||||
| 638 | # spent 56µs (39+17) within SQL::Translator::Schema::get_triggers which was called 4 times, avg 14µs/call:
# 4 times (39µs+17µs) by SQL::Translator::Producer::SQLite::produce at line 90 of SQL/Translator/Producer/SQLite.pm, avg 14µs/call | ||||
| 639 | |||||
| 640 | =pod | ||||
| 641 | |||||
| 642 | =head2 get_triggers | ||||
| 643 | |||||
| 644 | Returns all the triggers as an array or array reference. | ||||
| 645 | |||||
| 646 | my @triggers = $schema->get_triggers; | ||||
| 647 | |||||
| 648 | =cut | ||||
| 649 | |||||
| 650 | 20 | 42µs | my $self = shift; | ||
| 651 | my @triggers = | ||||
| 652 | map { $_->[1] } | ||||
| 653 | sort { $a->[0] <=> $b->[0] } | ||||
| 654 | 4 | 2µs | map { [ $_->order, $_ ] } values %{ $self->{'triggers'} }; # spent 2µs making 4 calls to SQL::Translator::Schema::CORE:sort, avg 400ns/call | ||
| 655 | |||||
| 656 | if (@triggers) { | ||||
| 657 | return wantarray ? @triggers : \@triggers; | ||||
| 658 | } | ||||
| 659 | else { | ||||
| 660 | 4 | 15µs | $self->error('No triggers'); # spent 15µs making 4 calls to Class::Base::error, avg 4µs/call | ||
| 661 | return wantarray ? () : undef; | ||||
| 662 | } | ||||
| 663 | } | ||||
| 664 | |||||
| 665 | # ---------------------------------------------------------------------- | ||||
| 666 | sub get_view { | ||||
| 667 | |||||
| 668 | =pod | ||||
| 669 | |||||
| 670 | =head2 get_view | ||||
| 671 | |||||
| 672 | Returns a view by the name provided. | ||||
| 673 | |||||
| 674 | my $view = $schema->get_view('foo'); | ||||
| 675 | |||||
| 676 | =cut | ||||
| 677 | |||||
| 678 | my $self = shift; | ||||
| 679 | my $view_name = shift or return $self->error('No view name'); | ||||
| 680 | return $self->error('View "$view_name" does not exist') | ||||
| 681 | unless exists $self->{'views'}{$view_name}; | ||||
| 682 | return $self->{'views'}{$view_name}; | ||||
| 683 | } | ||||
| 684 | |||||
| 685 | # ---------------------------------------------------------------------- | ||||
| 686 | # spent 97µs (73+24) within SQL::Translator::Schema::get_views which was called 4 times, avg 24µs/call:
# 4 times (73µs+24µs) by SQL::Translator::Producer::SQLite::produce at line 83 of SQL/Translator/Producer/SQLite.pm, avg 24µs/call | ||||
| 687 | |||||
| 688 | =pod | ||||
| 689 | |||||
| 690 | =head2 get_views | ||||
| 691 | |||||
| 692 | Returns all the views as an array or array reference. | ||||
| 693 | |||||
| 694 | my @views = $schema->get_views; | ||||
| 695 | |||||
| 696 | =cut | ||||
| 697 | |||||
| 698 | 20 | 75µs | my $self = shift; | ||
| 699 | my @views = | ||||
| 700 | map { $_->[1] } | ||||
| 701 | 2 | 6µs | sort { $a->[0] <=> $b->[0] } # spent 6µs making 2 calls to SQL::Translator::Schema::View::order, avg 3µs/call | ||
| 702 | 4 | 5µs | map { [ $_->order, $_ ] } values %{ $self->{'views'} }; # spent 5µs making 4 calls to SQL::Translator::Schema::CORE:sort, avg 1µs/call | ||
| 703 | |||||
| 704 | if (@views) { | ||||
| 705 | return wantarray ? @views : \@views; | ||||
| 706 | } | ||||
| 707 | else { | ||||
| 708 | 3 | 13µs | $self->error('No views'); # spent 13µs making 3 calls to Class::Base::error, avg 4µs/call | ||
| 709 | return wantarray ? () : undef; | ||||
| 710 | } | ||||
| 711 | } | ||||
| 712 | |||||
| 713 | # ---------------------------------------------------------------------- | ||||
| 714 | sub make_natural_joins { | ||||
| 715 | |||||
| 716 | =pod | ||||
| 717 | |||||
| 718 | =head2 make_natural_joins | ||||
| 719 | |||||
| 720 | Creates foriegn key relationships among like-named fields in different | ||||
| 721 | tables. Accepts the following arguments: | ||||
| 722 | |||||
| 723 | =over 4 | ||||
| 724 | |||||
| 725 | =item * join_pk_only | ||||
| 726 | |||||
| 727 | A True or False argument which determins whether or not to perform | ||||
| 728 | the joins from primary keys to fields of the same name in other tables | ||||
| 729 | |||||
| 730 | =item * skip_fields | ||||
| 731 | |||||
| 732 | A list of fields to skip in the joins | ||||
| 733 | |||||
| 734 | =back | ||||
| 735 | |||||
| 736 | $schema->make_natural_joins( | ||||
| 737 | join_pk_only => 1, | ||||
| 738 | skip_fields => 'name,department_id', | ||||
| 739 | ); | ||||
| 740 | |||||
| 741 | =cut | ||||
| 742 | |||||
| 743 | my $self = shift; | ||||
| 744 | my %args = @_; | ||||
| 745 | my $join_pk_only = $args{'join_pk_only'} || 0; | ||||
| 746 | my %skip_fields = | ||||
| 747 | map { s/^\s+|\s+$//g; $_, 1 } @{ parse_list_arg( $args{'skip_fields'} ) }; | ||||
| 748 | |||||
| 749 | my ( %common_keys, %pk ); | ||||
| 750 | for my $table ( $self->get_tables ) { | ||||
| 751 | for my $field ( $table->get_fields ) { | ||||
| 752 | my $field_name = $field->name or next; | ||||
| 753 | next if $skip_fields{$field_name}; | ||||
| 754 | $pk{$field_name} = 1 if $field->is_primary_key; | ||||
| 755 | push @{ $common_keys{$field_name} }, $table->name; | ||||
| 756 | } | ||||
| 757 | } | ||||
| 758 | |||||
| 759 | for my $field ( keys %common_keys ) { | ||||
| 760 | next if $join_pk_only and !defined $pk{$field}; | ||||
| 761 | |||||
| 762 | my @table_names = @{ $common_keys{$field} }; | ||||
| 763 | next unless scalar @table_names > 1; | ||||
| 764 | |||||
| 765 | for my $i ( 0 .. $#table_names ) { | ||||
| 766 | my $table1 = $self->get_table( $table_names[$i] ) or next; | ||||
| 767 | |||||
| 768 | for my $j ( 1 .. $#table_names ) { | ||||
| 769 | my $table2 = $self->get_table( $table_names[$j] ) or next; | ||||
| 770 | next if $table1->name eq $table2->name; | ||||
| 771 | |||||
| 772 | $table1->add_constraint( | ||||
| 773 | type => FOREIGN_KEY, | ||||
| 774 | fields => $field, | ||||
| 775 | reference_table => $table2->name, | ||||
| 776 | reference_fields => $field, | ||||
| 777 | ); | ||||
| 778 | } | ||||
| 779 | } | ||||
| 780 | } | ||||
| 781 | |||||
| 782 | return 1; | ||||
| 783 | } | ||||
| 784 | |||||
| 785 | # ---------------------------------------------------------------------- | ||||
| 786 | # spent 18µs within SQL::Translator::Schema::name which was called 8 times, avg 2µs/call:
# 8 times (18µs+0s) by SQL::Translator::Parser::DBIx::Class::parse at line 56 of SQL/Translator/Parser/DBIx/Class.pm, avg 2µs/call | ||||
| 787 | |||||
| 788 | =pod | ||||
| 789 | |||||
| 790 | =head2 name | ||||
| 791 | |||||
| 792 | Get or set the schema's name. (optional) | ||||
| 793 | |||||
| 794 | my $schema_name = $schema->name('Foo Database'); | ||||
| 795 | |||||
| 796 | =cut | ||||
| 797 | |||||
| 798 | 24 | 33µs | my $self = shift; | ||
| 799 | $self->{'name'} = shift if @_; | ||||
| 800 | return $self->{'name'} || ''; | ||||
| 801 | } | ||||
| 802 | |||||
| 803 | # ---------------------------------------------------------------------- | ||||
| 804 | # spent 12µs within SQL::Translator::Schema::translator which was called 4 times, avg 3µs/call:
# 4 times (12µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call | ||||
| 805 | |||||
| 806 | =pod | ||||
| 807 | |||||
| 808 | =head2 translator | ||||
| 809 | |||||
| 810 | Get the SQL::Translator instance that instantiated the parser. | ||||
| 811 | |||||
| 812 | =cut | ||||
| 813 | |||||
| 814 | 12 | 18µs | my $self = shift; | ||
| 815 | $self->{'translator'} = shift if @_; | ||||
| 816 | return $self->{'translator'}; | ||||
| 817 | } | ||||
| 818 | |||||
| 819 | # ---------------------------------------------------------------------- | ||||
| 820 | sub DESTROY { | ||||
| 821 | my $self = shift; | ||||
| 822 | undef $_ for values %{ $self->{'tables'} }; | ||||
| 823 | undef $_ for values %{ $self->{'views'} }; | ||||
| 824 | } | ||||
| 825 | |||||
| 826 | 1 | 5µs | 1; | ||
| 827 | |||||
| 828 | # ---------------------------------------------------------------------- | ||||
| 829 | |||||
| 830 | =pod | ||||
| 831 | |||||
| 832 | =head1 AUTHOR | ||||
| 833 | |||||
| 834 | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>. | ||||
| 835 | |||||
| 836 | =cut | ||||
| 837 | |||||
# spent 51µs within SQL::Translator::Schema::CORE:sort which was called 12 times, avg 4µs/call:
# 4 times (44µs+0s) by SQL::Translator::Schema::get_tables at line 606, avg 11µs/call
# 4 times (5µs+0s) by SQL::Translator::Schema::get_views at line 702, avg 1µs/call
# 4 times (2µs+0s) by SQL::Translator::Schema::get_triggers at line 654, avg 400ns/call |