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 | BEGIN@50 | SQL::Translator::Schema::
1 | 1 | 1 | 1.09ms | 1.46ms | BEGIN@51 | SQL::Translator::Schema::
4 | 1 | 1 | 848µs | 962µs | get_tables | SQL::Translator::Schema::
1 | 1 | 1 | 638µs | 4.45ms | BEGIN@49 | SQL::Translator::Schema::
1 | 1 | 1 | 623µs | 830µs | BEGIN@52 | SQL::Translator::Schema::
35 | 1 | 1 | 426µs | 900µs | add_table | SQL::Translator::Schema::
1 | 1 | 1 | 304µs | 828µs | BEGIN@48 | SQL::Translator::Schema::
35 | 1 | 1 | 101µs | 101µs | get_table | SQL::Translator::Schema::
4 | 1 | 1 | 86µs | 274µs | new | SQL::Translator::Schema::
4 | 1 | 1 | 73µs | 97µs | get_views | SQL::Translator::Schema::
2 | 1 | 1 | 56µs | 291µs | add_view | SQL::Translator::Schema::
12 | 3 | 1 | 51µs | 51µs | CORE:sort (opcode) | SQL::Translator::Schema::
4 | 1 | 1 | 39µs | 56µs | get_triggers | SQL::Translator::Schema::
8 | 1 | 1 | 18µs | 18µs | name | SQL::Translator::Schema::
1 | 1 | 1 | 12µs | 15µs | BEGIN@47 | SQL::Translator::Schema::
4 | 1 | 1 | 12µs | 12µs | translator | SQL::Translator::Schema::
1 | 1 | 1 | 7µs | 28µs | BEGIN@54 | SQL::Translator::Schema::
1 | 1 | 1 | 7µs | 23µs | BEGIN@57 | SQL::Translator::Schema::
1 | 1 | 1 | 7µs | 58µs | BEGIN@56 | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | DESTROY | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | add_procedure | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | add_trigger | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | as_graph | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | as_graph_pm | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | database | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | drop_procedure | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | drop_table | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | drop_trigger | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | drop_view | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | get_procedure | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | get_procedures | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | get_trigger | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | get_view | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | is_valid | SQL::Translator::Schema::
0 | 0 | 0 | 0s | 0s | make_natural_joins | SQL::Translator::Schema::
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 | 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 | ||||
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 | ||||
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 | 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 | ||||
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 | ||||
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 | ||||
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 |