File: | blib/lib/MySQL/Util/Data/Create.pm |
Coverage: | 82.4% |
line | stmt | bran | cond | sub | code |
---|---|---|---|---|---|
1 | package MySQL::Util::Data::Create; | ||||
2 | |||||
3 | 3 3 3 | use Moose::Role; | |||
4 | 3 3 3 | use Data::Dumper; | |||
5 | 3 3 3 | use SQL::Beautify; | |||
6 | 3 3 3 | use Symbol::Util 'delete_sub'; | |||
7 | 3 3 3 | use Smart::Args; | |||
8 | 3 3 3 | use feature 'state'; | |||
9 | 3 3 3 | use List::MoreUtils 'uniq'; | |||
10 | 3 3 3 | use Carp 'croak'; | |||
11 | 3 3 3 | use Config::General; | |||
12 | |||||
13 - 22 | =head1 NAME MySQL::Util::Data::Create - A Moose::Role for MySQL::Util. Do not call this directly! =head1 VERSION Version 0.01 =cut | ||||
23 | |||||
24 | our $VERSION = '0.01'; | ||||
25 | |||||
26 - 84 | =head1 SYNOPSIS use MySQL::Util; my $util = MySQL::Util->new(...); $util->create_data( table => 'sometable', rows => 500, defaults => { my_id => 10, enabled_flag => 1 }); =head1 SUBROUTINES/METHODS =head2 create_data( %args ) Creates X number of rows in the specified table. Columns are populated with random data if it can't be derived through auto-increment, foreign-keys, or enum. If defaults are provided they are used in favor over random values. =head3 Arguments: =over =item table name of table you want to create data in =item rows how many rows to create =item defaults (optional) A hashref that contains default data values for columns that may be encountered. If a column default is specified for which no column exists, it will be ignored. Each key is the column name and each value is the default value you wish to use. =back =head3 Examples: $util->create_data( table => 'mytable', rows => 50, defaults => { id => 44, age => 25 } ); $util->create_data( table => 'students', rows => 1000 ); =cut | ||||
85 | |||||
86 | has _create_cache => ( | ||||
87 | is => 'rw', | ||||
88 | isa => 'HashRef', | ||||
89 | required => 0, | ||||
90 | default => sub { {} }, | ||||
91 | ); | ||||
92 | |||||
93 | has _table_aliases => ( | ||||
94 | is => 'rw', | ||||
95 | isa => 'HashRef', | ||||
96 | required => 0, | ||||
97 | default => sub { {} }, | ||||
98 | ); | ||||
99 | |||||
100 | has _last_table_alias_num => ( | ||||
101 | is => 'rw', | ||||
102 | isa => 'Int', | ||||
103 | required => 0, | ||||
104 | default => 0 | ||||
105 | ); | ||||
106 | |||||
107 | sub _get_table_alias { | ||||
108 | 1007 | args | |||
109 | |||||
110 | # required | ||||
111 | my $self => 'Object', | ||||
112 | my $table => 'Str'; | ||||
113 | |||||
114 | 1007 | $table = $self->_fq( table => $table, fq => 1 ); | |||
115 | |||||
116 | 1007 | my $href = $self->_table_aliases; | |||
117 | |||||
118 | 1007 | if ( exists $href->{$table} ) { | |||
119 | 1002 | return $href->{$table}; | |||
120 | } | ||||
121 | |||||
122 | 5 | my $new_num = $self->_last_table_alias_num + 1; | |||
123 | 5 | my $new_alias = "t$new_num"; | |||
124 | |||||
125 | 5 | $href->{$table} = $new_alias; | |||
126 | 5 | $self->_table_aliases($href); | |||
127 | 5 | $self->_last_table_alias_num($new_num); | |||
128 | |||||
129 | 5 | return $new_alias; | |||
130 | } | ||||
131 | |||||
132 | sub _create_factory_method { | ||||
133 | 6 | args | |||
134 | |||||
135 | # required | ||||
136 | my $self => 'Object', | ||||
137 | my $table => 'Str', | ||||
138 | my $col_data_href => 'HashRef'; | ||||
139 | |||||
140 | 6 | my $method = 'create_factory_data'; | |||
141 | |||||
142 | 6 | if ( MySQL::Util->can($method) ) { | |||
143 | 5 | delete_sub "MySQL::Util::$method"; | |||
144 | } | ||||
145 | |||||
146 | 6 | my $col_rules = $self->_get_column_rules( | |||
147 | table => $table, | ||||
148 | col_data_href => $col_data_href | ||||
149 | ); | ||||
150 | 6 | $self->_verbose( "col_rules:\n" . Dumper($col_rules) ); | |||
151 | |||||
152 | 6 | my $factory = DBIx::DataFactory->new( { dbh => $self->_dbh } ); | |||
153 | |||||
154 | # what to do with $fm if anything? | ||||
155 | 6 | my $fm = $factory->create_factory_method( | |||
156 | method => $method, | ||||
157 | table => $table, | ||||
158 | install_package => 'MySQL::Util', | ||||
159 | auto_inserted_columns => $col_rules | ||||
160 | ); | ||||
161 | |||||
162 | 6 | return $method; | |||
163 | } | ||||
164 | |||||
165 | sub _parse_fq_col { | ||||
166 | 1 | args_pos | |||
167 | |||||
168 | # required | ||||
169 | my $self => 'Object', | ||||
170 | my $col => 'Str'; | ||||
171 | |||||
172 | 1 | my @a = split( /\./, $col ); | |||
173 | |||||
174 | 1 | confess "unable to parse column name: $col" if @a > 3; | |||
175 | |||||
176 | 1 | if ( @a == 3 ) { | |||
177 | 0 | return @a; | |||
178 | } | ||||
179 | elsif ( @a == 2 ) { | ||||
180 | 0 | return ( undef, @a ); | |||
181 | } | ||||
182 | |||||
183 | 1 | return ( '', '', $a[0] ); | |||
184 | } | ||||
185 | |||||
186 | sub _apply_defaults { | ||||
187 | 8 | args | |||
188 | |||||
189 | # required | ||||
190 | my $self => 'Object', | ||||
191 | my $table => 'Str', | ||||
192 | |||||
193 | # optional | ||||
194 | my $defaults => { isa => 'HashRef', default => {}, optional => 1 }, | ||||
195 | my $conf => { isa => 'Str|Undef', optional => 1}; | ||||
196 | |||||
197 | 8 | my $defaults_href; | |||
198 | |||||
199 | 8 | if ($conf) { | |||
200 | 0 | my $config = new Config::General($conf); | |||
201 | 0 | my %config = $config->getall; | |||
202 | |||||
203 | 0 | foreach my $col ( keys %config ) { | |||
204 | 0 | my $val = $config{$col}; | |||
205 | |||||
206 | 0 | my ( $dbname, $t, $c ) = $self->_parse_fq_col($col); | |||
207 | 0 | if ( $t eq $table ) { | |||
208 | 0 | $defaults_href->{$c} = $val; | |||
209 | } | ||||
210 | else { | ||||
211 | 0 | $defaults_href->{$col} = $val; | |||
212 | } | ||||
213 | } | ||||
214 | } | ||||
215 | |||||
216 | 8 | foreach my $col ( keys %$defaults ) { | |||
217 | # command line overrides conf file values | ||||
218 | 1 | my ( $dbname, $t, $c ) = $self->_parse_fq_col($col); | |||
219 | 1 | if ( $t eq $table ) { | |||
220 | 0 | $defaults_href->{$c} = $defaults->{$col}; | |||
221 | } | ||||
222 | else { | ||||
223 | 1 | $defaults_href->{$col} = $defaults->{$col}; | |||
224 | } | ||||
225 | } | ||||
226 | |||||
227 | 8 | return $defaults_href; | |||
228 | } | ||||
229 | |||||
230 | sub create_data { | ||||
231 | 9 | args | |||
232 | |||||
233 | # required | ||||
234 | my $self => 'Object', | ||||
235 | my $table => 'Str', | ||||
236 | my $rows => 'Int', | ||||
237 | |||||
238 | # optional | ||||
239 | my $defaults => { isa => 'HashRef', default => {}, optional => 1 }, | ||||
240 | my $conf => { isa => 'Str', optional => 1 }; | ||||
241 | |||||
242 | 8 | my $defaults_href = $self->_apply_defaults( | |||
243 | table => $table, | ||||
244 | defaults => $defaults, | ||||
245 | conf => $conf | ||||
246 | ); | ||||
247 | |||||
248 | # table MUST be in the current schema | ||||
249 | 8 | if ( $table =~ /^(\w+)\.(\w+)/ ) { | |||
250 | 0 | if ( $1 ne $self->_schema ) { | |||
251 | 0 | confess "table $table is not in the current schema"; | |||
252 | } | ||||
253 | } | ||||
254 | |||||
255 | # convert null to undef | ||||
256 | 8 | foreach my $col_name ( keys %$defaults_href ) { | |||
257 | 1 | if ( $defaults_href->{$col_name} =~ /^null$/i ) { | |||
258 | 0 | $defaults_href->{$col_name} = undef; | |||
259 | } | ||||
260 | } | ||||
261 | |||||
262 | 8 | my $method; | |||
263 | |||||
264 | 8 | for ( my $i = 0; $i < $rows; $i++ ) { | |||
265 | 217 | my %col_data = %$defaults_href; | |||
266 | 217 | $self->_verbose( "default data\n" . Dumper( \%col_data ) ); | |||
267 | |||||
268 | 217 | $self->_get_pk_data( table => $table, col_data_href => \%col_data ); | |||
269 | 216 | $self->_verbose( "after pk data\n" . Dumper( \%col_data ) ); | |||
270 | |||||
271 | 216 | $self->_get_ak_data( table => $table, col_data_href => \%col_data ); | |||
272 | 216 | $self->_verbose( "after ak data\n" . Dumper( \%col_data ) ); | |||
273 | |||||
274 | 216 | $self->_get_fk_data( table => $table, col_data_href => \%col_data ); | |||
275 | 215 | $self->_verbose( "after fk data\n" . Dumper( \%col_data ) ); | |||
276 | |||||
277 | 215 | $self->_get_enum_data( table => $table, col_data_href => \%col_data ); | |||
278 | 215 | $self->_verbose( "after enum data\n" . Dumper( \%col_data ) ); | |||
279 | |||||
280 | 215 | if ( !defined($method) ) { | |||
281 | 6 | $method = $self->_create_factory_method( | |||
282 | table => $table, | ||||
283 | col_data_href => \%col_data | ||||
284 | ); | ||||
285 | } | ||||
286 | |||||
287 | 215 | my $values = $self->$method(%col_data); | |||
288 | 215 | confess "got undef?" if !$values; | |||
289 | } | ||||
290 | |||||
291 | 6 | return $rows; | |||
292 | } | ||||
293 | |||||
294 | sub _get_table2alias_lookup { | ||||
295 | 41 | args | |||
296 | |||||
297 | # required | ||||
298 | my $self => 'Object', | ||||
299 | my $table => 'Str', | ||||
300 | my $constraint_name => 'Str', | ||||
301 | |||||
302 | # optional | ||||
303 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
304 | |||||
305 | 41 | $table = $self->_fq( table => $table, fq => $fq ); | |||
306 | |||||
307 | 41 | my %tables; | |||
308 | |||||
309 | 41 | my $i = 1; | |||
310 | 41 | my $con_aref = $self->get_constraints($table)->{$constraint_name}; | |||
311 | |||||
312 | 41 | foreach my $con_col_href (@$con_aref) { | |||
313 | 82 | my $col_name = $con_col_href->{COLUMN_NAME}; | |||
314 | 82 | my $ref_table; | |||
315 | |||||
316 | 82 | if ( $self->is_fk_column( table => $table, column => $col_name ) ) { | |||
317 | 82 | my $fk_col_href = $self->_get_fk_column( | |||
318 | table => $table, | ||||
319 | column => $col_name | ||||
320 | ); | ||||
321 | |||||
322 | 82 | my %parm = ( | |||
323 | table => $fk_col_href->{REFERENCED_TABLE_NAME}, | ||||
324 | fq => $fq | ||||
325 | ); | ||||
326 | |||||
327 | 82 | if ($fq) { | |||
328 | 82 | $parm{schema} = $fk_col_href->{REFERENCED_TABLE_SCHEMA}; | |||
329 | } | ||||
330 | |||||
331 | 82 | $ref_table = $self->_fq( %parm, fq => $fq ); | |||
332 | } | ||||
333 | else { | ||||
334 | 0 | $ref_table = $self->_fq( table => $table, fq => $fq ); | |||
335 | } | ||||
336 | |||||
337 | 82 | if ( !$tables{$ref_table} ) { | |||
338 | 82 | my $alias = 't' . $i; | |||
339 | 82 | $tables{$ref_table} = $alias; | |||
340 | 82 | $i++; | |||
341 | } | ||||
342 | } | ||||
343 | |||||
344 | 41 | return \%tables; | |||
345 | } | ||||
346 | |||||
347 | sub _get_where_not_exists { | ||||
348 | 41 | args | |||
349 | |||||
350 | # required | ||||
351 | my $self => 'Object', | ||||
352 | my $table => 'Str', | ||||
353 | my $constraint_name => 'Str', | ||||
354 | my $alias_href => 'HashRef', | ||||
355 | |||||
356 | # optional | ||||
357 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
358 | |||||
359 | 41 | $table = $self->_fq( table => $table, fq => $fq ); | |||
360 | |||||
361 | 41 | my $con_aref = $self->get_constraints($table)->{$constraint_name}; | |||
362 | 41 | my @where; | |||
363 | |||||
364 | 41 | foreach my $con_href (@$con_aref) { | |||
365 | |||||
366 | 82 | my $schema = $con_href->{CONSTRAINT_SCHEMA}; | |||
367 | 82 | my $col_name = $con_href->{COLUMN_NAME}; | |||
368 | |||||
369 | 82 | my $ref_alias; | |||
370 | 82 | my $ref_col; | |||
371 | |||||
372 | 82 | if ( $self->is_fk_column( table => $table, column => $col_name ) ) { | |||
373 | 82 | my $con_fk_href = $self->_get_fk_column( | |||
374 | table => $table, | ||||
375 | column => $col_name | ||||
376 | ); | ||||
377 | |||||
378 | 82 | my $ref_schema = $con_fk_href->{REFERENCED_TABLE_SCHEMA}; | |||
379 | 82 | my $ref_table = $con_fk_href->{REFERENCED_TABLE_NAME}; | |||
380 | 82 | my $joined = join '.', ( $ref_schema, $ref_table ); | |||
381 | |||||
382 | 82 | $ref_alias = $alias_href->{$joined}; | |||
383 | 82 | $ref_col = $con_fk_href->{REFERENCED_COLUMN_NAME}; | |||
384 | } | ||||
385 | else { | ||||
386 | 0 | $ref_alias = $alias_href->{$table}; | |||
387 | 0 | $ref_col = $col_name; | |||
388 | } | ||||
389 | |||||
390 | 82 | push @where, "x.$col_name = $ref_alias.$ref_col"; | |||
391 | } | ||||
392 | |||||
393 | 41 | my $where = join " and\n", @where; | |||
394 | |||||
395 | 41 | return qq{ | |||
396 | select * | ||||
397 | from $table x | ||||
398 | where $where | ||||
399 | } if $where; | ||||
400 | } | ||||
401 | |||||
402 | sub _get_where_clause { | ||||
403 | 42 | args | |||
404 | |||||
405 | # required | ||||
406 | my $self => 'Object', | ||||
407 | my $table => 'Str', | ||||
408 | my $col_data_href => 'HashRef', | ||||
409 | my $alias_href => 'HashRef'; | ||||
410 | |||||
411 | # | ||||
412 | # apply any known data to columns for tables in the from clause | ||||
413 | # | ||||
414 | 42 | my @where; | |||
415 | |||||
416 | 42 | foreach my $table ( keys %$alias_href ) { | |||
417 | 83 | my $desc_aref = $self->describe_table($table); | |||
418 | |||||
419 | 83 | foreach my $column_href (@$desc_aref) { | |||
420 | 125 | my $col_name = $column_href->{FIELD}; | |||
421 | |||||
422 | 125 | if ( exists $col_data_href->{$col_name} ) { | |||
423 | |||||
424 | 0 | my $table_alias = $alias_href->{$table}; | |||
425 | 0 | my $val = $col_data_href->{$col_name}; | |||
426 | |||||
427 | 0 | if ($self->_column_exists( | |||
428 | table => $table, | ||||
429 | column => $col_name | ||||
430 | ) | ||||
431 | ) | ||||
432 | { | ||||
433 | 0 | if ( !defined $val ) { | |||
434 | 0 | if ($self->is_column_nullable( | |||
435 | table => $table, | ||||
436 | column => $col_name | ||||
437 | ) | ||||
438 | ) | ||||
439 | { | ||||
440 | 0 | push( @where, "$table_alias.$col_name is NULL" ); | |||
441 | } | ||||
442 | else { | ||||
443 | 0 | confess | |||
444 | "tried to set a non-nullable column to null ($table.$col_name)"; | ||||
445 | } | ||||
446 | } | ||||
447 | else { | ||||
448 | 0 | push( @where, "$table_alias.$col_name = $val" ); | |||
449 | } | ||||
450 | } | ||||
451 | } | ||||
452 | } | ||||
453 | } | ||||
454 | |||||
455 | 42 | return join ' and ', @where; | |||
456 | } | ||||
457 | |||||
458 | sub _is_table_empty { | ||||
459 | 1 | args | |||
460 | |||||
461 | # required | ||||
462 | my $self => 'Object', | ||||
463 | my $table => 'Str', | ||||
464 | my $col_data_href => 'HashRef'; | ||||
465 | |||||
466 | 1 | my $alias_href = { $table => 't1' }; | |||
467 | |||||
468 | 1 | my $from = $self->_get_from_clause($alias_href); | |||
469 | |||||
470 | 1 | my $where = $self->_get_where_clause( | |||
471 | table => $table, | ||||
472 | col_data_href => $col_data_href, | ||||
473 | alias_href => $alias_href | ||||
474 | ); | ||||
475 | |||||
476 | 1 | my $sql = qq{ | |||
477 | select count(*) | ||||
478 | from $from | ||||
479 | }; | ||||
480 | |||||
481 | 1 | if ($where) { | |||
482 | 0 | $sql .= " where $where "; | |||
483 | } | ||||
484 | |||||
485 | 1 | my $cnt = $self->_dbh->selectrow_arrayref($sql)->[0]; | |||
486 | |||||
487 | 1 | if ( !$cnt ) { | |||
488 | 1 | return 1; | |||
489 | } | ||||
490 | |||||
491 | 0 | return 0; | |||
492 | } | ||||
493 | |||||
494 | sub _get_from_clause { | ||||
495 | 42 | args_pos | |||
496 | |||||
497 | # required | ||||
498 | my $self => 'Object', | ||||
499 | my $alias_href => 'HashRef'; | ||||
500 | |||||
501 | 42 | my @tables; | |||
502 | 42 | foreach my $t ( keys %$alias_href ) { | |||
503 | 83 | push( @tables, "$t $alias_href->{$t}" ); | |||
504 | } | ||||
505 | |||||
506 | 42 | return join ', ', @tables; | |||
507 | } | ||||
508 | |||||
509 | sub _get_func_cache { | ||||
510 | 116 | args | |||
511 | |||||
512 | # required | ||||
513 | my $self => 'Object'; | ||||
514 | |||||
515 | 116 | my $func = ( caller(1) )[3]; | |||
516 | |||||
517 | 116 | my $c = $self->_create_cache; | |||
518 | |||||
519 | 116 | if ( !exists $c->{$func} ) { | |||
520 | 1 | $c->{$func} = {}; | |||
521 | 1 | $self->_create_cache($c); | |||
522 | } | ||||
523 | |||||
524 | 116 | return $c->{$func}; | |||
525 | } | ||||
526 | |||||
527 | sub _get_constraint_non_fk_columns { | ||||
528 | 116 | args | |||
529 | |||||
530 | # required | ||||
531 | my $self => 'Object', | ||||
532 | my $table => 'Str', | ||||
533 | my $constraint_name => 'Str'; | ||||
534 | |||||
535 | 116 | my $c = $self->_get_func_cache; | |||
536 | |||||
537 | 116 | if ( defined $c->{$table}->{$constraint_name} ) { | |||
538 | 112 112 | return @{ $c->{$table}->{$constraint_name} }; | |||
539 | } | ||||
540 | |||||
541 | # $hashref->{constraint_name}->[ { col1 }, { col2 } ] | ||||
542 | # | ||||
543 | #Hash elements for each column: | ||||
544 | # | ||||
545 | # CONSTRAINT_SCHEMA | ||||
546 | # CONSTRAINT_TYPE | ||||
547 | # COLUMN_NAME | ||||
548 | # ORDINAL_POSITION | ||||
549 | # POSITION_IN_UNIQUE_CONSTRAINT | ||||
550 | # REFERENCED_COLUMN_NAME | ||||
551 | # REFERENCED_TABLE_SCHEMA | ||||
552 | # REFERENCED_TABLE_NAME | ||||
553 | |||||
554 | 4 | my @columns; | |||
555 | |||||
556 | 4 | my $con_aref | |||
557 | = $self->get_constraint( table => $table, name => $constraint_name ); | ||||
558 | |||||
559 | 4 | foreach my $col_href (@$con_aref) { | |||
560 | |||||
561 | 5 | my $col_name = $col_href->{COLUMN_NAME}; | |||
562 | |||||
563 | 5 | if ( !$self->is_fk_column( table => $table, column => $col_name ) ) { | |||
564 | 3 | push( @columns, $col_name ); | |||
565 | } | ||||
566 | } | ||||
567 | |||||
568 | 4 | $c->{$table}->{$constraint_name} = \@columns; | |||
569 | 4 | return @columns; | |||
570 | } | ||||
571 | |||||
572 | sub _get_uniq_constraint_data_sql { | ||||
573 | 41 | args | |||
574 | |||||
575 | # required | ||||
576 | my $self => 'Object', | ||||
577 | my $table => 'Str', | ||||
578 | my $col_data_href => 'HashRef', | ||||
579 | my $constraint_name => 'Str', | ||||
580 | |||||
581 | #optional | ||||
582 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
583 | |||||
584 | 41 | my $alias_href = $self->_get_table2alias_lookup( | |||
585 | table => $table, | ||||
586 | constraint_name => $constraint_name, | ||||
587 | fq => 1 | ||||
588 | ); | ||||
589 | |||||
590 | 41 | my $tables = $self->_get_from_clause($alias_href); | |||
591 | |||||
592 | 41 | my $cols = $self->_get_select_clause( | |||
593 | table => $table, | ||||
594 | constraint_name => $constraint_name, | ||||
595 | alias_href => $alias_href, | ||||
596 | fq => $fq | ||||
597 | ); | ||||
598 | |||||
599 | 41 | my $where = $self->_get_where_not_exists( | |||
600 | table => $table, | ||||
601 | constraint_name => $constraint_name, | ||||
602 | alias_href => $alias_href | ||||
603 | ); | ||||
604 | |||||
605 | 41 | my $extra_criteria = $self->_get_where_clause( | |||
606 | table => $table, | ||||
607 | col_data_href => $col_data_href, | ||||
608 | alias_href => $alias_href, | ||||
609 | ); | ||||
610 | 41 | $extra_criteria = " and $extra_criteria " if $extra_criteria; | |||
611 | |||||
612 | # TODO: implement this for randomness: | ||||
613 | # | ||||
614 | #SELECT name | ||||
615 | # FROM random AS r1 JOIN | ||||
616 | # (SELECT (RAND() * | ||||
617 | # (SELECT MAX(id) | ||||
618 | # FROM random)) AS id) | ||||
619 | # AS r2 | ||||
620 | # WHERE r1.id >= r2.id | ||||
621 | # ORDER BY r1.id ASC | ||||
622 | # LIMIT 1 | ||||
623 | # | ||||
624 | |||||
625 | 41 | my $sql = qq{ | |||
626 | select distinct $cols | ||||
627 | from $tables | ||||
628 | where not exists ($where) | ||||
629 | $extra_criteria | ||||
630 | limit 1 | ||||
631 | }; | ||||
632 | |||||
633 | 41 | return $sql; | |||
634 | } | ||||
635 | |||||
636 | sub _get_uniq_constraint_data { | ||||
637 | 116 | args | |||
638 | |||||
639 | #required | ||||
640 | my $self => 'Object', | ||||
641 | my $table => 'Str', | ||||
642 | my $col_data_href => 'HashRef', | ||||
643 | my $constraint_name => 'Str', | ||||
644 | |||||
645 | #optional | ||||
646 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
647 | |||||
648 | 116 | $table = $self->_fq( table => $table, fq => $fq ); | |||
649 | |||||
650 | 116 | if (!$self->_get_constraint_non_fk_columns( | |||
651 | table => $table, | ||||
652 | constraint_name => $constraint_name | ||||
653 | ) | ||||
654 | ) | ||||
655 | { | ||||
656 | |||||
657 | # | ||||
658 | # the data for each column, in the uniq constraint, has to come from | ||||
659 | # a reference table | ||||
660 | # | ||||
661 | 41 | my $sql = $self->_get_uniq_constraint_data_sql( | |||
662 | table => $table, | ||||
663 | col_data_href => $col_data_href, | ||||
664 | constraint_name => $constraint_name, | ||||
665 | fq => $fq | ||||
666 | ); | ||||
667 | 41 | $self->_verbose_sql($sql); | |||
668 | |||||
669 | 41 | my $href = $self->_dbh->selectrow_hashref($sql); | |||
670 | 41 | if ( !$href ) { | |||
671 | 1 | if ( $self->is_self_referencing( table => $table ) ) { | |||
672 | 0 | confess "self referencing tables not implemented"; | |||
673 | } | ||||
674 | elsif ( | ||||
675 | $self->_is_table_empty( | ||||
676 | table => $table, | ||||
677 | col_data_href => $col_data_href | ||||
678 | ) | ||||
679 | ) | ||||
680 | { | ||||
681 | |||||
682 | # let it go through | ||||
683 | } | ||||
684 | else { | ||||
685 | 0 | confess "not enough data in parent table(s) to create a " | |||
686 | . "new row due to constraint $constraint_name"; | ||||
687 | } | ||||
688 | } | ||||
689 | else { | ||||
690 | 40 | foreach my $col ( keys %$href ) { | |||
691 | |||||
692 | 80 | if ( !exists $col_data_href->{ lc $col } ) { | |||
693 | |||||
694 | 80 | $col_data_href->{ lc $col } = $href->{$col}; | |||
695 | } | ||||
696 | } | ||||
697 | } | ||||
698 | } | ||||
699 | } | ||||
700 | |||||
701 | sub _join_tables { | ||||
702 | 50 | args | |||
703 | |||||
704 | # required | ||||
705 | my $self => 'Object', | ||||
706 | my $child_table => 'Str', | ||||
707 | my $parent_table => 'Str'; | ||||
708 | |||||
709 | # | ||||
710 | # debug stuff | ||||
711 | # | ||||
712 | 50 | shift; | |||
713 | 50 | $self->_verbose( "enter:\n" . Dumper( \@_ ) ); | |||
714 | |||||
715 | 50 | $child_table = $self->_fq( table => $child_table, fq => 1 ); | |||
716 | 50 | my $child_alias = $self->_get_table_alias( table => $child_table ); | |||
717 | |||||
718 | 50 | $parent_table = $self->_fq( table => $parent_table, fq => 1 ); | |||
719 | |||||
720 | 50 | my $join_sql; | |||
721 | 50 | my $fks_href = $self->get_fk_constraints($child_table); | |||
722 | |||||
723 | 50 | foreach my $fk_name ( keys %$fks_href ) { | |||
724 | 100 | my $fk_aref = $fks_href->{$fk_name}; | |||
725 | 100 | my $ref_table = $fk_aref->[0]->{REFERENCED_TABLE_NAME}; | |||
726 | 100 | my $ref_schema = $fk_aref->[0]->{REFERENCED_TABLE_SCHEMA}; | |||
727 | 100 | my $ref_fq = $self->_fq( | |||
728 | table => $ref_table, | ||||
729 | schema => $ref_schema, | ||||
730 | fq => 1 | ||||
731 | ); | ||||
732 | |||||
733 | 100 | $self->_verbose("ref_fq=$ref_fq\nparent_table=$parent_table"); | |||
734 | |||||
735 | 100 | if ( $ref_fq eq $parent_table ) { | |||
736 | 50 | my $ref_alias = $self->_get_table_alias( table => $ref_fq ); | |||
737 | |||||
738 | 50 | foreach my $col_href (@$fk_aref) { | |||
739 | 50 | $join_sql .= sprintf( "%s.%s = %s.%s\n", | |||
740 | $ref_alias, $col_href->{REFERENCED_COLUMN_NAME}, | ||||
741 | $child_alias, $col_href->{COLUMN_NAME} ); | ||||
742 | } | ||||
743 | } | ||||
744 | } | ||||
745 | |||||
746 | 50 | $self->_verbose($join_sql); | |||
747 | 50 | return $join_sql; | |||
748 | } | ||||
749 | |||||
750 | sub _build_select_clause { | ||||
751 | 171 | args | |||
752 | |||||
753 | # required | ||||
754 | my $self => 'Object', | ||||
755 | my $table => 'Str', | ||||
756 | my $fk_tree => 'HashRef'; | ||||
757 | |||||
758 | # | ||||
759 | # debug stuff | ||||
760 | # | ||||
761 | 171 | shift; | |||
762 | 171 | $self->_verbose( "enter:\n" . Dumper( \@_ ) ); | |||
763 | |||||
764 | 171 | $table = $self->_fq( table => $table, fq => 1 ); | |||
765 | |||||
766 | 171 | my @select; | |||
767 | |||||
768 | 171 | my $fks_href = $self->get_fk_constraints($table); | |||
769 | |||||
770 | 171 | foreach my $fk_name ( keys %$fks_href ) { | |||
771 | 212 | my $fk_aref = $fks_href->{$fk_name}; | |||
772 | |||||
773 | 212 | my $ref_table_fq = $self->_fq( | |||
774 | table => $fk_aref->[0]->{REFERENCED_TABLE_NAME}, | ||||
775 | schema => $fk_aref->[0]->{REFERENCED_TABLE_SCHEMA}, | ||||
776 | fq => 1 | ||||
777 | ); | ||||
778 | |||||
779 | 212 | if ( exists $fk_tree->{$ref_table_fq} ) { | |||
780 | 212 | my $ref_alias = $self->_get_table_alias( table => $ref_table_fq ); | |||
781 | |||||
782 | 212 | foreach my $col_href (@$fk_aref) { | |||
783 | |||||
784 | 212 | push( @select, | |||
785 | "$ref_alias." . $col_href->{REFERENCED_COLUMN_NAME} ); | ||||
786 | } | ||||
787 | } | ||||
788 | } | ||||
789 | |||||
790 | 171 | my $select = join ', ', @select; | |||
791 | 171 | $self->_verbose("return:\n$select"); | |||
792 | 171 | return $select; | |||
793 | } | ||||
794 | |||||
795 | sub _build_from_clause { | ||||
796 | 221 | args | |||
797 | |||||
798 | # required | ||||
799 | my $self => 'Object', | ||||
800 | my $table => 'Str', | ||||
801 | my $fk_tree => 'HashRef', | ||||
802 | |||||
803 | # optional | ||||
804 | my $depth => { isa => 'Int', optional => 1, default => 0 }; | ||||
805 | |||||
806 | # | ||||
807 | # debug stuff | ||||
808 | # | ||||
809 | 221 | shift; | |||
810 | 221 | $self->_verbose( "enter:\n" . Dumper( \@_ ) ); | |||
811 | |||||
812 | 221 | my %from; | |||
813 | |||||
814 | 221 | if ( !$depth ) { | |||
815 | 171 | foreach my $parent_table ( keys %$fk_tree ) { | |||
816 | |||||
817 | 212 212 | if ( scalar keys %{ $fk_tree->{$parent_table} } ) { | |||
818 | |||||
819 | 50 | my %tmp = $self->_build_from_clause( | |||
820 | table => $parent_table, | ||||
821 | fk_tree => $fk_tree->{$parent_table}, | ||||
822 | depth => $depth + 1 | ||||
823 | ); | ||||
824 | 50 | foreach my $key ( keys %tmp ) { | |||
825 | 100 100 100 | push( @{ $from{$key} }, @{ $tmp{$key} } ); | |||
826 | } | ||||
827 | } | ||||
828 | else { | ||||
829 | 162 | my $alias = $self->_get_table_alias( table => $parent_table ); | |||
830 | 162 | $from{"$parent_table $alias"} = []; | |||
831 | } | ||||
832 | } | ||||
833 | } | ||||
834 | else { | ||||
835 | 50 | foreach my $parent_table ( keys %$fk_tree ) { | |||
836 | |||||
837 | 50 | my $join = $self->_join_tables( | |||
838 | child_table => $table, | ||||
839 | parent_table => $parent_table | ||||
840 | ); | ||||
841 | |||||
842 | 50 | my $alias = $self->_get_table_alias( table => $table ); | |||
843 | 50 | if ( !$from{"$table $alias"} ) { | |||
844 | 50 | $from{"$table $alias"} = []; | |||
845 | } | ||||
846 | |||||
847 | 50 | $alias = $self->_get_table_alias( table => $parent_table ); | |||
848 | 50 50 | push( @{ $from{"$parent_table $alias"} }, $join ); | |||
849 | |||||
850 | 50 50 | if ( scalar keys %{ $fk_tree->{$parent_table} } ) { | |||
851 | |||||
852 | 0 | my %tmp = $self->_build_from_clause( | |||
853 | table => $parent_table, | ||||
854 | fk_tree => $fk_tree->{$parent_table}, | ||||
855 | depth => $depth + 1 | ||||
856 | ); | ||||
857 | 0 | foreach my $key ( keys %tmp ) { | |||
858 | 0 0 0 | push( @{ $from{$key} }, @{ $tmp{$key} } ); | |||
859 | } | ||||
860 | } | ||||
861 | } | ||||
862 | } | ||||
863 | |||||
864 | 221 | $self->_verbose( "return:\n" . Dumper( \%from ) ); | |||
865 | 221 | return %from; | |||
866 | } | ||||
867 | |||||
868 | sub _build_where_clause { | ||||
869 | 433 | args | |||
870 | |||||
871 | # required | ||||
872 | my $self => 'Object', | ||||
873 | my $table => 'Str', | ||||
874 | my $fk_tree => 'HashRef', | ||||
875 | my $col_data_href => 'HashRef', | ||||
876 | |||||
877 | # optional | ||||
878 | my $depth => { isa => 'Int', optional => 1, default => 0 }; | ||||
879 | |||||
880 | # | ||||
881 | # debug stuff | ||||
882 | # | ||||
883 | 433 | shift; | |||
884 | 433 | $self->_verbose( "enter:\n" . Dumper( \@_ ) ); | |||
885 | |||||
886 | 433 | my @where; | |||
887 | |||||
888 | 433 | if ($depth) { | |||
889 | 262 | my $desc = $self->describe_table($table); | |||
890 | 262 | my $alias = $self->_get_table_alias( table => $table ); | |||
891 | |||||
892 | 262 | foreach my $col_href (@$desc) { | |||
893 | 453 | my $col_name = lc $col_href->{FIELD}; | |||
894 | |||||
895 | 453 | if ( exists $col_data_href->{$col_name} ) { | |||
896 | 130 | push( @where, | |||
897 | "$alias.$col_name = $col_data_href->{$col_name}" ); | ||||
898 | |||||
899 | # delete $col_data_href->{$col_name}; | ||||
900 | } | ||||
901 | } | ||||
902 | } | ||||
903 | |||||
904 | 433 | foreach my $parent_table ( keys %$fk_tree ) { | |||
905 | 262 | push( | |||
906 | @where, | ||||
907 | $self->_build_where_clause( | ||||
908 | table => $parent_table, | ||||
909 | fk_tree => $fk_tree->{$parent_table}, | ||||
910 | col_data_href => $col_data_href, | ||||
911 | depth => $depth + 1 | ||||
912 | ) | ||||
913 | ); | ||||
914 | } | ||||
915 | |||||
916 | 433 | $self->_verbose("@where"); | |||
917 | 433 | return @where; | |||
918 | } | ||||
919 | |||||
920 | sub _get_fk_data { | ||||
921 | 216 | args my $self => 'Object', | |||
922 | my $table => 'Str', | ||||
923 | my $col_data_href => 'HashRef'; | ||||
924 | |||||
925 | 216 | my $fk_tree = $self->_get_fk_tree( | |||
926 | table => $table, | ||||
927 | remaining_data_href => {%$col_data_href}, | ||||
928 | |||||
929 | ); | ||||
930 | 216 | $self->_verbose( "fk_tree:\n " . Dumper($fk_tree) ); | |||
931 | |||||
932 | 216 | if ( scalar keys %$fk_tree ) { | |||
933 | |||||
934 | 171 | my $select = $self->_build_select_clause( | |||
935 | table => $table, | ||||
936 | fk_tree => $fk_tree | ||||
937 | ); | ||||
938 | 171 | $self->_verbose($select); | |||
939 | |||||
940 | 171 | my %from = $self->_build_from_clause( | |||
941 | table => $table, | ||||
942 | fk_tree => $fk_tree | ||||
943 | ); | ||||
944 | 171 | my $alias = $self->_get_table_alias( table => $table ); | |||
945 | 171 | my $from = ''; | |||
946 | |||||
947 | 171 | my %depth_chart; | |||
948 | |||||
949 | 171 | foreach my $t ( keys %from ) { | |||
950 | 262 | my ( $tname, $talias ) = split( /\s+/, $t ); | |||
951 | 262 | my $dep = $self->get_depth($tname); | |||
952 | 262 | $depth_chart{$dep}->{$t} = 1; | |||
953 | } | ||||
954 | |||||
955 | 171 | my @from_tables; | |||
956 | 171 | my @no_join_tables; | |||
957 | |||||
958 | 171 91 | foreach my $depth ( sort { $b <=> $a } keys(%depth_chart) ) { | |||
959 | |||||
960 | 262 | my $ptr = $depth_chart{$depth}; | |||
961 | |||||
962 | 262 | foreach my $t ( keys %$ptr ) { | |||
963 | |||||
964 | # foreach my $t ( keys %from ) { | ||||
965 | 262 262 | my @a = @{ $from{$t} }; | |||
966 | 262 | @a = uniq @a; | |||
967 | 262 | if ( !@a ) { | |||
968 | 212 | push( @no_join_tables, $t ); | |||
969 | } | ||||
970 | else { | ||||
971 | 50 | $from .= "inner join $t on " . join( ' and ', @a ); | |||
972 | 50 | $from .= "\n"; | |||
973 | } | ||||
974 | |||||
975 | 262 | push( @from_tables, $t ); | |||
976 | } | ||||
977 | } | ||||
978 | 171 | my $tmp = $from; | |||
979 | 171 | $from = join( "\ninner join\n", @no_join_tables ); | |||
980 | 171 | $from .= "\n$tmp" if $tmp; | |||
981 | 171 | $self->_verbose($from); | |||
982 | |||||
983 | 171 | my @where = $self->_build_where_clause( | |||
984 | table => $table, | ||||
985 | fk_tree => $fk_tree, | ||||
986 | col_data_href => {%$col_data_href} | ||||
987 | ); | ||||
988 | 171 | my $where = join( ' and ', uniq @where ); | |||
989 | 171 | $self->_verbose($where); | |||
990 | |||||
991 | 171 | my $sql = qq{ | |||
992 | select | ||||
993 | $select | ||||
994 | from | ||||
995 | $from | ||||
996 | }; | ||||
997 | 171 | $sql .= qq{ | |||
998 | where | ||||
999 | $where | ||||
1000 | } if $where; | ||||
1001 | 171 | $sql .= q{ | |||
1002 | limit 1 | ||||
1003 | }; | ||||
1004 | 171 | $self->_verbose_sql($sql); | |||
1005 | |||||
1006 | 171 | my $href = $self->_dbh->selectrow_hashref($sql); | |||
1007 | 171 | if ( !$href ) { | |||
1008 | 1 | my $msg | |||
1009 | = "not enough data in one (or more) parent table(s) to create " | ||||
1010 | . "a new row in table $table\n\nparent tables:\n"; | ||||
1011 | |||||
1012 | 1 | foreach my $t ( sort uniq @from_tables ) { | |||
1013 | 0 | $msg .= "\t$t\n\n"; | |||
1014 | } | ||||
1015 | |||||
1016 | 0 | croak $msg; | |||
1017 | } | ||||
1018 | else { | ||||
1019 | 170 | foreach my $col ( keys %$href ) { | |||
1020 | 210 | if ( !exists $col_data_href->{ lc $col } ) { | |||
1021 | 130 | if ( !defined( $href->{$col} ) ) { | |||
1022 | 0 | if (!$self->is_column_nullable( | |||
1023 | table => $table, | ||||
1024 | column => $col | ||||
1025 | ) | ||||
1026 | ) | ||||
1027 | { | ||||
1028 | 0 | confess | |||
1029 | "tried to set a non-nullable column to null ($table.$col)"; | ||||
1030 | } | ||||
1031 | } | ||||
1032 | |||||
1033 | 130 | $col_data_href->{ lc $col } = $href->{$col}; | |||
1034 | } | ||||
1035 | } | ||||
1036 | } | ||||
1037 | } | ||||
1038 | |||||
1039 | $self->_convert_missing_fk_cols_to_undef( | ||||
1040 | 215 | table => $table, | |||
1041 | col_data_href => $col_data_href | ||||
1042 | ); | ||||
1043 | } | ||||
1044 | |||||
1045 | # | ||||
1046 | # find foreign key _tables_ that we are missing data for return in a | ||||
1047 | # hierarchical structure | ||||
1048 | # | ||||
1049 | sub _get_fk_tree { | ||||
1050 | 769 | args | |||
1051 | |||||
1052 | # required | ||||
1053 | my $self => 'Object', | ||||
1054 | my $remaining_data_href => 'HashRef', | ||||
1055 | my $table => 'Str', | ||||
1056 | |||||
1057 | # optional | ||||
1058 | my $depth => { isa => 'Int', optional => 1, default => 0 }; | ||||
1059 | |||||
1060 | 769 | my $node = {}; | |||
1061 | |||||
1062 | # | ||||
1063 | # debug stuff | ||||
1064 | # | ||||
1065 | 769 | my @a = @_; | |||
1066 | 769 | shift @a; | |||
1067 | 769 | $self->_verbose( Dumper( \@a ) ); | |||
1068 | |||||
1069 | # | ||||
1070 | # all data qualifications satisfied | ||||
1071 | # | ||||
1072 | # return | ||||
1073 | # if | ||||
1074 | # keys %$remaining_data_href == 0; # no reason to continue up the chain | ||||
1075 | |||||
1076 | # | ||||
1077 | # does this table have any columns for which we have data left? | ||||
1078 | # | ||||
1079 | 769 | my $hit; | |||
1080 | |||||
1081 | 769 | if ( $depth != 0 ) { # skip root table | |||
1082 | |||||
1083 | 553 | my $desc = $self->describe_table($table); | |||
1084 | 553 | foreach my $col_href (@$desc) { | |||
1085 | |||||
1086 | 794 | my $col_name = $col_href->{FIELD}; | |||
1087 | |||||
1088 | 794 | if ( exists( $remaining_data_href->{$col_name} ) ) { | |||
1089 | |||||
1090 | # we have a hit | ||||
1091 | 130 | delete $remaining_data_href->{$col_name}; | |||
1092 | 130 | $self->_verbose("removed col $col_name"); | |||
1093 | 130 | $hit++; | |||
1094 | } | ||||
1095 | |||||
1096 | # if ( keys %$remaining_data_href == 0 ) { | ||||
1097 | # return $node; | ||||
1098 | # } | ||||
1099 | } | ||||
1100 | } | ||||
1101 | |||||
1102 | # | ||||
1103 | # if we get here we are still in search of columns to match with | ||||
1104 | # remaining_data_href. through recursion, keep walking the foreign keys | ||||
1105 | # up the hierarchy. | ||||
1106 | # | ||||
1107 | 769 | my %seen; | |||
1108 | |||||
1109 | 769 | my $fks_href = $self->get_fk_constraints($table); | |||
1110 | |||||
1111 | 769 | foreach my $fk_name ( keys %$fks_href ) { | |||
1112 | 553 | $self->_verbose("fk=$fk_name"); | |||
1113 | |||||
1114 | 553 | my $fk_aref = $fks_href->{$fk_name}; | |||
1115 | |||||
1116 | 553 | my $col_href = shift @$fk_aref; # only need one column from fk | |||
1117 | |||||
1118 | 553 | my $ref_table = $col_href->{REFERENCED_TABLE_NAME}; | |||
1119 | 553 | my $ref_schema = $col_href->{REFERENCED_TABLE_SCHEMA}; | |||
1120 | 553 | my $ref_fq = $self->_fq( | |||
1121 | table => $ref_table, | ||||
1122 | schema => $ref_schema, | ||||
1123 | fq => 1 | ||||
1124 | ); | ||||
1125 | |||||
1126 | 553 | if ($self->is_self_referencing( | |||
1127 | table => $ref_fq, | ||||
1128 | name => $fk_name | ||||
1129 | ) | ||||
1130 | ) | ||||
1131 | { | ||||
1132 | 0 | $self->_verbose("$fk_name is self referencing"); | |||
1133 | 0 | next; | |||
1134 | } | ||||
1135 | |||||
1136 | # next if $seen{$ref_fq}; | ||||
1137 | # $seen{$ref_fq} = 1; | ||||
1138 | |||||
1139 | 553 | my $href = $self->_get_fk_tree( | |||
1140 | remaining_data_href => {%$remaining_data_href}, | ||||
1141 | table => $ref_fq, | ||||
1142 | depth => $depth + 1 | ||||
1143 | ); | ||||
1144 | 553 | if ( $href or $depth == 0 ) { | |||
1145 | 262 | $hit++; # if a parent has a hit, we automatically do too | |||
1146 | 262 | if ( !$href ) { | |||
1147 | 82 | $href = {}; | |||
1148 | } | ||||
1149 | |||||
1150 | 262 | $node->{$ref_fq} = $href; | |||
1151 | } | ||||
1152 | } | ||||
1153 | |||||
1154 | 769 | $self->_verbose( Dumper($node) ); | |||
1155 | 769 | if ($hit) { | |||
1156 | 351 | return $node; | |||
1157 | } | ||||
1158 | |||||
1159 | 418 | return; | |||
1160 | } | ||||
1161 | |||||
1162 | sub _convert_missing_fk_cols_to_undef { | ||||
1163 | 215 | args | |||
1164 | |||||
1165 | # required | ||||
1166 | my $self => 'Object', | ||||
1167 | my $table => 'Str', | ||||
1168 | my $col_data_href => 'HashRef'; | ||||
1169 | |||||
1170 | # | ||||
1171 | # debugging stuff | ||||
1172 | # | ||||
1173 | 215 | state $cnt++; | |||
1174 | 215 | shift @_; | |||
1175 | 215 | $self->_verbose( "enter\n\nargs:\n" . Dumper(@_), $cnt ); | |||
1176 | |||||
1177 | 215 | foreach my $col ( $self->get_fk_column_names( table => $table ) ) { | |||
1178 | 210 | if ( !exists $col_data_href->{$col} ) { | |||
1179 | 0 | if (!$self->is_column_nullable( | |||
1180 | table => $table, | ||||
1181 | column => $col | ||||
1182 | ) | ||||
1183 | ) | ||||
1184 | { | ||||
1185 | 0 | confess | |||
1186 | "tried to set a non-nullable column to null ($table.$col)\n\n" | ||||
1187 | . Dumper($col_data_href); | ||||
1188 | } | ||||
1189 | |||||
1190 | 0 | $col_data_href->{$col} = undef; | |||
1191 | } | ||||
1192 | } | ||||
1193 | } | ||||
1194 | |||||
1195 | sub _get_ak_data { | ||||
1196 | 216 | args | |||
1197 | |||||
1198 | # required | ||||
1199 | my $self => 'Object', | ||||
1200 | my $table => 'Str', | ||||
1201 | my $col_data_href => 'HashRef', | ||||
1202 | |||||
1203 | #optional | ||||
1204 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
1205 | |||||
1206 | 216 | $table = $self->_fq( table => $table, fq => $fq ); | |||
1207 | |||||
1208 | 216 | if ( $self->has_ak($table) ) { | |||
1209 | |||||
1210 | 0 | my $aks_href = $self->get_ak_constraints($table); | |||
1211 | |||||
1212 | 0 | foreach my $ak_name ( keys %$aks_href ) { | |||
1213 | |||||
1214 | 0 | $self->_get_uniq_constraint_data( | |||
1215 | table => $table, | ||||
1216 | col_data_href => $col_data_href, | ||||
1217 | constraint_name => $ak_name | ||||
1218 | ); | ||||
1219 | } | ||||
1220 | } | ||||
1221 | } | ||||
1222 | |||||
1223 | sub _get_pk_data { | ||||
1224 | 217 | args | |||
1225 | |||||
1226 | # required | ||||
1227 | my $self => 'Object', | ||||
1228 | my $table => 'Str', | ||||
1229 | my $col_data_href => 'HashRef', | ||||
1230 | |||||
1231 | # optional | ||||
1232 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
1233 | |||||
1234 | 217 | $table = $self->_fq( table => $table, fq => $fq ); | |||
1235 | |||||
1236 | 217 | if ( $self->has_pk($table) and !$self->is_pk_auto_inc($table) ) { | |||
1237 | |||||
1238 | 116 | $self->_get_uniq_constraint_data( | |||
1239 | table => $table, | ||||
1240 | col_data_href => $col_data_href, | ||||
1241 | constraint_name => $self->get_pk_name($table) | ||||
1242 | ); | ||||
1243 | } | ||||
1244 | |||||
1245 | 216 | return; | |||
1246 | } | ||||
1247 | |||||
1248 | sub _get_column_rules { | ||||
1249 | 6 | args | |||
1250 | |||||
1251 | # required | ||||
1252 | my $self => 'Object', | ||||
1253 | my $table => 'Str', | ||||
1254 | my $col_data_href => 'HashRef'; | ||||
1255 | |||||
1256 | 6 | state $cnt++; | |||
1257 | 6 | shift @_; | |||
1258 | 6 | $self->_verbose( "enter($cnt)\nargs:\n\n" . Dumper(@_), $cnt ); | |||
1259 | |||||
1260 | 6 | my %rules; | |||
1261 | |||||
1262 | # $arrayref->[ { col1 }, { col2 } ] | ||||
1263 | # | ||||
1264 | #Hash elements for each column: | ||||
1265 | # | ||||
1266 | # DEFAULT | ||||
1267 | # EXTRA | ||||
1268 | # FIELD | ||||
1269 | # KEY | ||||
1270 | # NULL | ||||
1271 | # TYPE | ||||
1272 | #mysql> DESCRIBE pet; | ||||
1273 | #+---------+-------------+------+-----+---------+-------+ | ||||
1274 | #| Field | Type | Null | Key | Default | Extra | | ||||
1275 | #+---------+-------------+------+-----+---------+-------+ | ||||
1276 | #| name | varchar(20) | YES | | NULL | | | ||||
1277 | #| owner | varchar(20) | YES | | NULL | | | ||||
1278 | #| species | varchar(20) | YES | | NULL | | | ||||
1279 | #| sex | char(1) | YES | | NULL | | | ||||
1280 | #| birth | date | YES | | NULL | | | ||||
1281 | #| death | date | YES | | NULL | | | ||||
1282 | #+---------+-------------+------+-----+---------+-------+ | ||||
1283 | |||||
1284 | 6 6 | foreach my $col ( @{ $self->describe_table($table) } ) { | |||
1285 | 10 | $self->_verbose("col = $col"); | |||
1286 | |||||
1287 | 10 | my $name = $col->{FIELD}; | |||
1288 | 10 | my $type = $col->{TYPE}; | |||
1289 | 10 | my $size; | |||
1290 | |||||
1291 | 10 | next if exists $col_data_href->{$name}; | |||
1292 | 5 | next if $col->{EXTRA} =~ /auto/; | |||
1293 | next | ||||
1294 | 3 | if $self->is_fk_column( table => $table, column => $col ); | |||
1295 | |||||
1296 | 3 | if ( $type =~ /varchar\((\d+)\)/ ) { | |||
1297 | 0 | $type = 'Str'; | |||
1298 | 0 | $size = int( $1 / 2 ); | |||
1299 | } | ||||
1300 | elsif ( $type =~ /char\((\d+)\)/ ) { | ||||
1301 | 0 | $type = 'Str'; | |||
1302 | 0 | $size = $1; | |||
1303 | } | ||||
1304 | elsif ( $type =~ /int\((\d+)\)/ ) { | ||||
1305 | 3 | $type = 'Int'; | |||
1306 | 3 | $size = int( $1 / 2 ); | |||
1307 | } | ||||
1308 | elsif ( $type =~ /date/ ) { | ||||
1309 | 0 | next; | |||
1310 | } | ||||
1311 | elsif ( $type =~ /^enum\((.+)\)$/ ) { | ||||
1312 | 0 | next; | |||
1313 | } | ||||
1314 | else { | ||||
1315 | 0 | confess " unhandled column type : $type "; | |||
1316 | } | ||||
1317 | |||||
1318 | 3 | $rules{$name} = { type => $type, size => $size }; | |||
1319 | } | ||||
1320 | |||||
1321 | 6 | $self->_verbose( "leave", $cnt ); | |||
1322 | |||||
1323 | 6 | return \%rules; | |||
1324 | } | ||||
1325 | |||||
1326 | sub _get_enum_data { | ||||
1327 | 215 | args | |||
1328 | |||||
1329 | # required | ||||
1330 | my $self => 'Object', | ||||
1331 | my $table => 'Str', | ||||
1332 | my $col_data_href => 'HashRef'; | ||||
1333 | |||||
1334 | 215 215 | foreach my $col_href ( @{ $self->describe_table($table) } ) { | |||
1335 | |||||
1336 | 385 | my $col_name = $col_href->{FIELD}; | |||
1337 | |||||
1338 | 385 | next if $col_href->{EXTRA} =~ /auto/; | |||
1339 | 285 | next if exists $col_data_href->{$col_name}; | |||
1340 | |||||
1341 | 75 | my $name = $col_href->{FIELD}; | |||
1342 | 75 | my $type = $col_href->{TYPE}; | |||
1343 | 75 | my $size; | |||
1344 | |||||
1345 | 75 | if ( $type =~ /^enum\((.+)\)$/ ) { | |||
1346 | 0 | my @a = split /,/, $type; | |||
1347 | 0 | my $i = int( rand( scalar @a ) ); | |||
1348 | 0 | $a[$i] =~ /'(\w+)'/; | |||
1349 | 0 | my $val = $1; | |||
1350 | |||||
1351 | 0 | $col_data_href->{$col_name} = $val; | |||
1352 | } | ||||
1353 | } | ||||
1354 | } | ||||
1355 | |||||
1356 | sub _get_column2alias_lookup { | ||||
1357 | 41 | args | |||
1358 | |||||
1359 | # required | ||||
1360 | my $self => 'Object', | ||||
1361 | my $table => 'Str', | ||||
1362 | my $constraint_name => 'Str', | ||||
1363 | my $alias_href => 'HashRef', | ||||
1364 | |||||
1365 | # optional | ||||
1366 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
1367 | |||||
1368 | 41 | $table = $self->_fq( table => $table, fq => $fq ); | |||
1369 | |||||
1370 | 41 | my @cols; | |||
1371 | 41 | my %cols2alias; | |||
1372 | |||||
1373 | 41 | my $con_aref = $self->get_constraint( | |||
1374 | table => $table, | ||||
1375 | name => $constraint_name | ||||
1376 | ); | ||||
1377 | |||||
1378 | 41 | foreach my $con_col_href (@$con_aref) { | |||
1379 | |||||
1380 | 82 | my %parm; | |||
1381 | 82 | my $col_name = $con_col_href->{COLUMN_NAME}; | |||
1382 | |||||
1383 | 82 | if ($self->is_fk_column( | |||
1384 | table => $table, | ||||
1385 | column => $col_name | ||||
1386 | ) | ||||
1387 | ) | ||||
1388 | { | ||||
1389 | 82 | my $fk_col_href = $self->_get_fk_column( | |||
1390 | table => $table, | ||||
1391 | column => $col_name | ||||
1392 | ); | ||||
1393 | |||||
1394 | 82 | if ($fq) { | |||
1395 | 82 | $parm{schema} = $fk_col_href->{REFERENCED_TABLE_SCHEMA}; | |||
1396 | } | ||||
1397 | |||||
1398 | 82 | $parm{table} = $fk_col_href->{REFERENCED_TABLE_NAME}; | |||
1399 | 82 | $col_name | |||
1400 | = $fk_col_href->{REFERENCED_COLUMN_NAME} . " as $col_name"; | ||||
1401 | } | ||||
1402 | else { | ||||
1403 | 0 | if ($fq) { | |||
1404 | 0 | $parm{schema} = $con_col_href->{CONSTRAINT_SCHEMA}; | |||
1405 | } | ||||
1406 | |||||
1407 | 0 | $parm{table} = $table; | |||
1408 | } | ||||
1409 | 82 | my $ref_table = $self->_fq( %parm, fq => $fq ); | |||
1410 | |||||
1411 | 82 | $cols2alias{$col_name} = $alias_href->{$ref_table}; | |||
1412 | } | ||||
1413 | |||||
1414 | 41 | return \%cols2alias; | |||
1415 | } | ||||
1416 | |||||
1417 | sub _get_select_clause { | ||||
1418 | 41 | args | |||
1419 | |||||
1420 | # required | ||||
1421 | my $self => 'Object', | ||||
1422 | my $table => 'Str', | ||||
1423 | my $constraint_name => 'Str', | ||||
1424 | my $alias_href => 'HashRef', | ||||
1425 | |||||
1426 | # optional | ||||
1427 | my $fq => { isa => 'Bool', optional => 1, default => 1 }; | ||||
1428 | |||||
1429 | 41 | my $col2alias = $self->_get_column2alias_lookup( | |||
1430 | table => $table, | ||||
1431 | constraint_name => $constraint_name, | ||||
1432 | alias_href => $alias_href, | ||||
1433 | fq => $fq | ||||
1434 | ); | ||||
1435 | |||||
1436 | 41 | my @cols; | |||
1437 | |||||
1438 | 41 | foreach my $col ( keys %$col2alias ) { | |||
1439 | 82 | push( @cols, sprintf "%s.%s", $col2alias->{$col}, $col ); | |||
1440 | } | ||||
1441 | |||||
1442 | 41 | return join ', ', @cols; | |||
1443 | } | ||||
1444 | |||||
1445 - 1532 | =head1 AUTHOR John Gravatt, C<< <john at gravatt.org> >> =head1 BUGS Please report any bugs or feature requests to C<bug-mysql-util-data-create at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MySQL-Util-Data-Create>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc MySQL::Util::Data::Create You can also look for information at: =over 4 =item * RT: CPAN's request tracker (report bugs here) L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MySQL-Util-Data-Create> =item * AnnoCPAN: Annotated CPAN documentation L<http://annocpan.org/dist/MySQL-Util-Data-Create> =item * CPAN Ratings L<http://cpanratings.perl.org/d/MySQL-Util-Data-Create> =item * Search CPAN L<http://search.cpan.org/dist/MySQL-Util-Data-Create/> =back =head1 ACKNOWLEDGEMENTS =head1 LICENSE AND COPYRIGHT Copyright 2013 John Gravatt. This program is free software; you can redistribute it and/or modify it under the terms of the the Artistic License (2.0). You may obtain a copy of the full license at: L<http://www.perlfoundation.org/artistic_license_2_0> Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =cut | ||||
1533 | |||||
1534 | 1; # End of MySQL::Util::Data::Create | ||||
1535 |