Profile of SQL/Translator/Schema.pm

← 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:23:17 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 3.05ms | 9.09ms | SQL::Translator::Schema::::BEGIN@50SQL::Translator::Schema::BEGIN@50
1 | 1 | 1 | 1.09ms | 1.46ms | SQL::Translator::Schema::::BEGIN@51SQL::Translator::Schema::BEGIN@51
4 | 1 | 1 | 848µs | 962µs | SQL::Translator::Schema::::get_tablesSQL::Translator::Schema::get_tables
1 | 1 | 1 | 638µs | 4.45ms | SQL::Translator::Schema::::BEGIN@49SQL::Translator::Schema::BEGIN@49
1 | 1 | 1 | 623µs | 830µs | SQL::Translator::Schema::::BEGIN@52SQL::Translator::Schema::BEGIN@52
35 | 1 | 1 | 426µs | 900µs | SQL::Translator::Schema::::add_tableSQL::Translator::Schema::add_table
1 | 1 | 1 | 304µs | 828µs | SQL::Translator::Schema::::BEGIN@48SQL::Translator::Schema::BEGIN@48
35 | 1 | 1 | 101µs | 101µs | SQL::Translator::Schema::::get_tableSQL::Translator::Schema::get_table
4 | 1 | 1 | 86µs | 274µs | SQL::Translator::Schema::::newSQL::Translator::Schema::new
4 | 1 | 1 | 73µs | 97µs | SQL::Translator::Schema::::get_viewsSQL::Translator::Schema::get_views
2 | 1 | 1 | 56µs | 291µs | SQL::Translator::Schema::::add_viewSQL::Translator::Schema::add_view
12 | 3 | 1 | 51µs | 51µs | SQL::Translator::Schema::::CORE:sortSQL::Translator::Schema::CORE:sort (opcode)
4 | 1 | 1 | 39µs | 56µs | SQL::Translator::Schema::::get_triggersSQL::Translator::Schema::get_triggers
8 | 1 | 1 | 18µs | 18µs | SQL::Translator::Schema::::nameSQL::Translator::Schema::name
1 | 1 | 1 | 12µs | 15µs | SQL::Translator::Schema::::BEGIN@47SQL::Translator::Schema::BEGIN@47
4 | 1 | 1 | 12µs | 12µs | SQL::Translator::Schema::::translatorSQL::Translator::Schema::translator
1 | 1 | 1 | 7µs | 28µs | SQL::Translator::Schema::::BEGIN@54SQL::Translator::Schema::BEGIN@54
1 | 1 | 1 | 7µs | 23µs | SQL::Translator::Schema::::BEGIN@57SQL::Translator::Schema::BEGIN@57
1 | 1 | 1 | 7µs | 58µs | SQL::Translator::Schema::::BEGIN@56SQL::Translator::Schema::BEGIN@56
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::DESTROYSQL::Translator::Schema::DESTROY
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::add_procedureSQL::Translator::Schema::add_procedure
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::add_triggerSQL::Translator::Schema::add_trigger
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::as_graphSQL::Translator::Schema::as_graph
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::as_graph_pmSQL::Translator::Schema::as_graph_pm
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::databaseSQL::Translator::Schema::database
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::drop_procedureSQL::Translator::Schema::drop_procedure
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::drop_tableSQL::Translator::Schema::drop_table
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::drop_triggerSQL::Translator::Schema::drop_trigger
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::drop_viewSQL::Translator::Schema::drop_view
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::get_procedureSQL::Translator::Schema::get_procedure
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::get_proceduresSQL::Translator::Schema::get_procedures
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::get_triggerSQL::Translator::Schema::get_trigger
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::get_viewSQL::Translator::Schema::get_view
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::::is_validSQL::Translator::Schema::is_valid
0 | 0 | 0 | 0s | 0s | SQL::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
--- | --- | --- | --- | --- | ---
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 use strict; # 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 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
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 use SQL::Translator::Schema::Procedure; # 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 use SQL::Translator::Schema::Table; # 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 use SQL::Translator::Schema::Trigger; # 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 use SQL::Translator::Schema::View; # 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 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 |  |  |  |  |
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 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
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 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 |  |  |  |  |
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 sub new {
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 sub add_table {
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 | 280 | 308µs |  |  | my $self = shift;
147 |  |  |  |  | my $table_class = 'SQL::Translator::Schema::Table';
148 |  |  |  |  | my $table;
149 |  |  |  |  |
150 | 70 | 46µs | 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 | 35 | 34µs |  |  | 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 sub add_view {
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 | 16 | 26µs |  |  | my $self = shift;
409 |  |  |  |  | my $view_class = 'SQL::Translator::Schema::View';
410 |  |  |  |  | my $view;
411 |  |  |  |  |
412 | 8 | 25µs | 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 | 2 | 2µs |  |  | 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 sub get_table {
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 sub get_tables {
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 | 12 | 132µ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 | 35 | 735µs | 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 sub get_triggers {
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 | 12 | 22µ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 | 8 | 20µs |  |  | 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 sub get_views {
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 | 12 | 39µ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 | 2 | 6µs | 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 | 6 | 31µs |  |  | 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 sub name {
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 sub translator {
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 sub SQL::Translator::Schema::CORE:sort; # opcode