← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:24:04 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema.pm
StatementsExecuted 790 statements in 4.29ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1113.05ms9.09msSQL::Translator::Schema::::BEGIN@50SQL::Translator::Schema::BEGIN@50
1111.09ms1.46msSQL::Translator::Schema::::BEGIN@51SQL::Translator::Schema::BEGIN@51
411848µs962µsSQL::Translator::Schema::::get_tablesSQL::Translator::Schema::get_tables
111638µs4.45msSQL::Translator::Schema::::BEGIN@49SQL::Translator::Schema::BEGIN@49
111623µs830µsSQL::Translator::Schema::::BEGIN@52SQL::Translator::Schema::BEGIN@52
3511426µs900µsSQL::Translator::Schema::::add_tableSQL::Translator::Schema::add_table
111304µs828µsSQL::Translator::Schema::::BEGIN@48SQL::Translator::Schema::BEGIN@48
3511101µs101µsSQL::Translator::Schema::::get_tableSQL::Translator::Schema::get_table
41186µs274µsSQL::Translator::Schema::::newSQL::Translator::Schema::new
41173µs97µsSQL::Translator::Schema::::get_viewsSQL::Translator::Schema::get_views
21156µs291µsSQL::Translator::Schema::::add_viewSQL::Translator::Schema::add_view
123151µs51µsSQL::Translator::Schema::::CORE:sortSQL::Translator::Schema::CORE:sort (opcode)
41139µs56µsSQL::Translator::Schema::::get_triggersSQL::Translator::Schema::get_triggers
81118µs18µsSQL::Translator::Schema::::nameSQL::Translator::Schema::name
11112µs15µsSQL::Translator::Schema::::BEGIN@47SQL::Translator::Schema::BEGIN@47
41112µs12µsSQL::Translator::Schema::::translatorSQL::Translator::Schema::translator
1117µs28µsSQL::Translator::Schema::::BEGIN@54SQL::Translator::Schema::BEGIN@54
1117µs23µsSQL::Translator::Schema::::BEGIN@57SQL::Translator::Schema::BEGIN@57
1117µs58µsSQL::Translator::Schema::::BEGIN@56SQL::Translator::Schema::BEGIN@56
0000s0sSQL::Translator::Schema::::DESTROYSQL::Translator::Schema::DESTROY
0000s0sSQL::Translator::Schema::::add_procedureSQL::Translator::Schema::add_procedure
0000s0sSQL::Translator::Schema::::add_triggerSQL::Translator::Schema::add_trigger
0000s0sSQL::Translator::Schema::::as_graphSQL::Translator::Schema::as_graph
0000s0sSQL::Translator::Schema::::as_graph_pmSQL::Translator::Schema::as_graph_pm
0000s0sSQL::Translator::Schema::::databaseSQL::Translator::Schema::database
0000s0sSQL::Translator::Schema::::drop_procedureSQL::Translator::Schema::drop_procedure
0000s0sSQL::Translator::Schema::::drop_tableSQL::Translator::Schema::drop_table
0000s0sSQL::Translator::Schema::::drop_triggerSQL::Translator::Schema::drop_trigger
0000s0sSQL::Translator::Schema::::drop_viewSQL::Translator::Schema::drop_view
0000s0sSQL::Translator::Schema::::get_procedureSQL::Translator::Schema::get_procedure
0000s0sSQL::Translator::Schema::::get_proceduresSQL::Translator::Schema::get_procedures
0000s0sSQL::Translator::Schema::::get_triggerSQL::Translator::Schema::get_trigger
0000s0sSQL::Translator::Schema::::get_viewSQL::Translator::Schema::get_view
0000s0sSQL::Translator::Schema::::is_validSQL::Translator::Schema::is_valid
0000s0sSQL::Translator::Schema::::make_natural_joinsSQL::Translator::Schema::make_natural_joins
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package 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
25SQL::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
40C<SQL::Translator::Schema> is the object that accepts, validates, and
41returns the database structure.
42
43=head1 METHODS
44
45=cut
46
47318µs217µ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
use strict;
# spent 15µs making 1 call to SQL::Translator::Schema::BEGIN@47 # spent 2µs making 1 call to strict::import
483103µs2883µ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
use SQL::Translator::Schema::Constants;
# spent 828µs making 1 call to SQL::Translator::Schema::BEGIN@48 # spent 55µs making 1 call to Exporter::import
493101µs14.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
use SQL::Translator::Schema::Procedure;
# spent 4.45ms making 1 call to SQL::Translator::Schema::BEGIN@49
503122µs19.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
use SQL::Translator::Schema::Table;
# spent 9.09ms making 1 call to SQL::Translator::Schema::BEGIN@50
513132µs11.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
use SQL::Translator::Schema::Trigger;
# spent 1.46ms making 1 call to SQL::Translator::Schema::BEGIN@51
523111µs1830µ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
use SQL::Translator::Schema::View;
# spent 830µs making 1 call to SQL::Translator::Schema::BEGIN@52
53
54319µs250µ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
use SQL::Translator::Utils 'parse_list_arg';
# spent 28µs making 1 call to SQL::Translator::Schema::BEGIN@54 # spent 21µs making 1 call to Exporter::import
55
56320µs2110µ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
use base 'SQL::Translator::Schema::Object';
# spent 58µs making 1 call to SQL::Translator::Schema::BEGIN@56 # spent 52µs making 1 call to base::import
5731.96ms238µ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
use vars qw[ $VERSION ];
# spent 23µs making 1 call to SQL::Translator::Schema::BEGIN@57 # spent 16µs making 1 call to vars::import
58
591800ns$VERSION = '1.59';
60
6118µs157µ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
sub new {
6445µs my $class = shift;
65446µs4188µs my $self = $class->SUPER::new (@_)
# spent 188µs making 4 calls to Class::Base::new, avg 47µs/call
66 or return;
67
68424µs $self->{_order} = { map { $_ => 0 } qw/
69 table
70 view
71 trigger
72 proc
73 /};
74
75413µs return $self;
76}
77
78# ----------------------------------------------------------------------
79sub as_graph {
80
81=pod
82
83=head2 as_graph
84
85Returns 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# ----------------------------------------------------------------------
97sub as_graph_pm {
98
99=pod
100
101=head2 as_graph_pm
102
103Returns 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
sub add_table {
130
131=pod
132
133=head2 add_table
134
135Add a table object. Returns the new SQL::Translator::Schema::Table object.
136The "name" parameter is required. If you try to create a table with the
137same name as an existing table, you will get an error and the table will
138not 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
1463510µs my $self = shift;
1473510µs my $table_class = 'SQL::Translator::Schema::Table';
148355µs my $table;
149
15035101µs3530µs if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
# spent 30µs making 35 calls to UNIVERSAL::isa, avg 866ns/call
151359µs $table = shift;
1523538µs35194µ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
1613553µs35189µ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.
1643542µs3560µs my $table_name = $table->name;
# spent 60µs making 35 calls to SQL::Translator::Schema::Table::name, avg 2µs/call
165
1663524µs if ( defined $self->{'tables'}{$table_name} ) {
167 return $self->error(qq[Can't create table: "$table_name" exists]);
168 }
169 else {
1703534µs $self->{'tables'}{$table_name} = $table;
171 }
172
1733563µs return $table;
174}
175
176# ----------------------------------------------------------------------
177sub drop_table {
178
179=pod
180
181=head2 drop_table
182
183Remove a table from the schema. Returns the table object if the table was found
184and removed, an error otherwise. The single parameter can be either a table
185name or an C<SQL::Translator::Schema::Table> object. The "cascade" parameter
186can 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# ----------------------------------------------------------------------
222sub add_procedure {
223
224=pod
225
226=head2 add_procedure
227
228Add a procedure object. Returns the new SQL::Translator::Schema::Procedure
229object. The "name" parameter is required. If you try to create a procedure
230with the same name as an existing procedure, you will get an error and the
231procedure 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# ----------------------------------------------------------------------
271sub drop_procedure {
272
273=pod
274
275=head2 drop_procedure
276
277Remove a procedure from the schema. Returns the procedure object if the
278procedure was found and removed, an error otherwise. The single parameter
279can be either a procedure name or an C<SQL::Translator::Schema::Procedure>
280object.
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# ----------------------------------------------------------------------
308sub add_trigger {
309
310=pod
311
312=head2 add_trigger
313
314Add a trigger object. Returns the new SQL::Translator::Schema::Trigger object.
315The "name" parameter is required. If you try to create a trigger with the
316same name as an existing trigger, you will get an error and the trigger will
317not 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# ----------------------------------------------------------------------
355sub drop_trigger {
356
357=pod
358
359=head2 drop_trigger
360
361Remove a trigger from the schema. Returns the trigger object if the trigger was
362found and removed, an error otherwise. The single parameter can be either a
363trigger 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
sub add_view {
392
393=pod
394
395=head2 add_view
396
397Add a view object. Returns the new SQL::Translator::Schema::View object.
398The "name" parameter is required. If you try to create a view with the
399same name as an existing view, you will get an error and the view will
400not 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
4082800ns my $self = shift;
4092800ns my $view_class = 'SQL::Translator::Schema::View';
4102500ns my $view;
411
41228µs22µ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 {
41728µs my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
4182900ns $args{'schema'} = $self;
4192700ns return $self->error('No view name') unless $args{'name'};
420215µs2215µ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
42325µs216µs $view->order( ++$self->{_order}{view} );
# spent 16µs making 2 calls to SQL::Translator::Schema::View::order, avg 8µs/call
42423µs23µ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
42623µs if ( defined $self->{'views'}{$view_name} ) {
427 return $self->error(qq[Can't create view: "$view_name" exists]);
428 }
429 else {
43022µs $self->{'views'}{$view_name} = $view;
431 }
432
43326µs return $view;
434}
435
436# ----------------------------------------------------------------------
437sub drop_view {
438
439=pod
440
441=head2 drop_view
442
443Remove a view from the schema. Returns the view object if the view was found
444and removed, an error otherwise. The single parameter can be either a view
445name 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# ----------------------------------------------------------------------
472sub database {
473
474=pod
475
476=head2 database
477
478Get 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# ----------------------------------------------------------------------
490sub is_valid {
491
492=pod
493
494=head2 is_valid
495
496Returns 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# ----------------------------------------------------------------------
514sub get_procedure {
515
516=pod
517
518=head2 get_procedure
519
520Returns 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# ----------------------------------------------------------------------
534sub get_procedures {
535
536=pod
537
538=head2 get_procedures
539
540Returns 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
sub get_table {
563
564=pod
565
566=head2 get_table
567
568Returns a table by the name provided.
569
570 my $table = $schema->get_table('foo');
571
572=cut
573
5743511µs my $self = shift;
5753512µs my $table_name = shift or return $self->error('No table name');
576359µs my $case_insensitive = shift;
577356µs 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 }
5843516µs return $self->error(qq[Table "$table_name" does not exist])
585 unless exists $self->{'tables'}{$table_name};
5863578µs 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
sub get_tables {
591
592=pod
593
594=head2 get_tables
595
596Returns all the tables as an array or array reference.
597
598 my @tables = $schema->get_tables;
599
600=cut
601
60243µs my $self = shift;
603 my @tables =
604 map { $_->[1] }
60535735µs3570µs sort { $a->[0] <=> $b->[0] }
# spent 70µs making 35 calls to SQL::Translator::Schema::Table::order, avg 2µs/call
6064110µs444µs map { [ $_->order, $_ ] } values %{ $self->{'tables'} };
# spent 44µs making 4 calls to SQL::Translator::Schema::CORE:sort, avg 11µs/call
607
608419µs if (@tables) {
609 return wantarray ? @tables : \@tables;
610 }
611 else {
612 $self->error('No tables');
613 return wantarray ? () : undef;
614 }
615}
616
617# ----------------------------------------------------------------------
618sub get_trigger {
619
620=pod
621
622=head2 get_trigger
623
624Returns 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
sub get_triggers {
639
640=pod
641
642=head2 get_triggers
643
644Returns all the triggers as an array or array reference.
645
646 my @triggers = $schema->get_triggers;
647
648=cut
649
65042µs my $self = shift;
651 my @triggers =
652 map { $_->[1] }
653 sort { $a->[0] <=> $b->[0] }
654418µs42µs map { [ $_->order, $_ ] } values %{ $self->{'triggers'} };
# spent 2µs making 4 calls to SQL::Translator::Schema::CORE:sort, avg 400ns/call
655
65642µs if (@triggers) {
657 return wantarray ? @triggers : \@triggers;
658 }
659 else {
66047µs415µs $self->error('No triggers');
# spent 15µs making 4 calls to Class::Base::error, avg 4µs/call
661413µs return wantarray ? () : undef;
662 }
663}
664
665# ----------------------------------------------------------------------
666sub get_view {
667
668=pod
669
670=head2 get_view
671
672Returns 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
sub get_views {
687
688=pod
689
690=head2 get_views
691
692Returns all the views as an array or array reference.
693
694 my @views = $schema->get_views;
695
696=cut
697
69842µs my $self = shift;
699 my @views =
700 map { $_->[1] }
70126µs26µs sort { $a->[0] <=> $b->[0] }
# spent 6µs making 2 calls to SQL::Translator::Schema::View::order, avg 3µs/call
702432µs45µs map { [ $_->order, $_ ] } values %{ $self->{'views'} };
# spent 5µs making 4 calls to SQL::Translator::Schema::CORE:sort, avg 1µs/call
703
70446µs if (@views) {
705 return wantarray ? @views : \@views;
706 }
707 else {
708320µs313µs $self->error('No views');
# spent 13µs making 3 calls to Class::Base::error, avg 4µs/call
709311µs return wantarray ? () : undef;
710 }
711}
712
713# ----------------------------------------------------------------------
714sub make_natural_joins {
715
716=pod
717
718=head2 make_natural_joins
719
720Creates foriegn key relationships among like-named fields in different
721tables. Accepts the following arguments:
722
723=over 4
724
725=item * join_pk_only
726
727A True or False argument which determins whether or not to perform
728the joins from primary keys to fields of the same name in other tables
729
730=item * skip_fields
731
732A 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
sub name {
787
788=pod
789
790=head2 name
791
792Get or set the schema's name. (optional)
793
794 my $schema_name = $schema->name('Foo Database');
795
796=cut
797
79883µs my $self = shift;
79984µs $self->{'name'} = shift if @_;
800825µs 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
sub translator {
805
806=pod
807
808=head2 translator
809
810Get the SQL::Translator instance that instantiated the parser.
811
812=cut
813
81442µs my $self = shift;
81544µs $self->{'translator'} = shift if @_;
816413µs return $self->{'translator'};
817}
818
819# ----------------------------------------------------------------------
820sub DESTROY {
821 my $self = shift;
822 undef $_ for values %{ $self->{'tables'} };
823 undef $_ for values %{ $self->{'views'} };
824}
825
82615µs1;
827
828# ----------------------------------------------------------------------
829
830=pod
831
832=head1 AUTHOR
833
834Ken 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
sub SQL::Translator::Schema::CORE:sort; # opcode