File: | blib/lib/MySQL/Util.pm |
Coverage: | 86.0% |
line | stmt | bran | cond | sub | code |
---|---|---|---|---|---|
1 | package MySQL::Util; | ||||
2 | 3 3 3 | use Moose; | |||
3 | 3 3 3 | use namespace::autoclean; | |||
4 | 3 3 3 | use DBI; | |||
5 | 3 3 3 | use Carp; | |||
6 | 3 3 3 | use DBIx::DataFactory; | |||
7 | 3 3 3 | use Data::Dumper; | |||
8 | $Data::Dumper::Sortkeys = 1; | ||||
9 | 3 3 3 | use MySQL::Util::Data::Cache; | |||
10 | 3 3 3 | use Smart::Args; | |||
11 | |||||
12 | with 'MySQL::Util::Data::Create'; | ||||
13 | |||||
14 - 22 | =head1 NAME MySQL::Util - Utility functions for working with MySQL. =head1 VERSION Version 0.29 =cut | ||||
23 | |||||
24 | our $VERSION = '0.34'; | ||||
25 | |||||
26 - 75 | =head1 SYNOPSIS =for text my $util = MySQL::Util->new( dsn => $ENV{DBI_DSN}, user => $ENV{DBI_USER} ); my $util = MySQL::Util->new( dsn => $ENV{DBI_DSN}, user => $ENV{DBI_USER}, span => 1); my $util = MySQL::Util->new( dbh => $dbh ); my $aref = $util->describe_table('mytable'); print "table: mytable\n"; foreach my $href (@$aref) { print "\t", $href->{FIELD}, "\n"; } my $href = $util->get_ak_constraints('mytable'); my $href = $util->get_ak_indexes('mytable'); my $href = $util->get_constraints('mytable'); # # drop foreign keys example 1 # my $fks_aref = $util->drop_fks(); < do some work here - perhaps truncate tables > $util->apply_ddl($fks_aref); # this will clear the cache for us. see # clear_cache() for more info. # # drop foreign keys example 2 # my $fks_aref = $util->drop_fks(); my $dbh = $util->clone_dbh; foreach my $stmt (@$fks_aref) { $dbh->do($stmt); } $util->clear_cache; # we modified the database ddl outside of the object so # we need to clear the object's internal cache. see # clear_cache() for more info. =cut | ||||
76 | |||||
77 | # | ||||
78 | # public variables | ||||
79 | # | ||||
80 | |||||
81 | has 'dsn' => ( | ||||
82 | is => 'ro', | ||||
83 | isa => 'Str', | ||||
84 | required => 0 | ||||
85 | ); | ||||
86 | |||||
87 | has 'user' => ( | ||||
88 | is => 'ro', | ||||
89 | isa => 'Str', | ||||
90 | required => 0 | ||||
91 | ); | ||||
92 | |||||
93 | has 'pass' => ( | ||||
94 | is => 'ro', | ||||
95 | required => 0, | ||||
96 | default => undef | ||||
97 | ); | ||||
98 | |||||
99 | has 'span' => ( | ||||
100 | is => 'ro', | ||||
101 | isa => 'Int', | ||||
102 | required => 0, | ||||
103 | default => 0 | ||||
104 | ); | ||||
105 | |||||
106 | has 'dbh' => ( | ||||
107 | is => 'rw', | ||||
108 | isa => 'Object', | ||||
109 | ); | ||||
110 | |||||
111 | # | ||||
112 | # private variables | ||||
113 | # | ||||
114 | |||||
115 | has '_dbh' => ( | ||||
116 | is => 'ro', | ||||
117 | writer => '_set_dbh', | ||||
118 | init_arg => undef, # By setting the init_arg to undef, we make it | ||||
119 | # impossible to set this attribute when creating a new object. | ||||
120 | ); | ||||
121 | |||||
122 | has '_index_cache' => ( | ||||
123 | is => 'rw', | ||||
124 | isa => 'HashRef[MySQL::Util::Data::Cache]', | ||||
125 | init_arg => undef, | ||||
126 | default => sub { {} } | ||||
127 | ); | ||||
128 | |||||
129 | has '_constraint_cache' => ( | ||||
130 | is => 'rw', | ||||
131 | isa => 'HashRef[MySQL::Util::Data::Cache]', | ||||
132 | init_arg => undef, | ||||
133 | default => sub { {} } | ||||
134 | ); | ||||
135 | |||||
136 | has '_depth_cache' => ( | ||||
137 | is => 'rw', | ||||
138 | isa => 'HashRef', | ||||
139 | init_arg => undef, | ||||
140 | default => sub { {} } | ||||
141 | ); | ||||
142 | |||||
143 | has '_describe_cache' => ( | ||||
144 | is => 'rw', | ||||
145 | isa => 'HashRef', | ||||
146 | init_arg => undef, | ||||
147 | default => sub { {} } | ||||
148 | ); | ||||
149 | |||||
150 | has '_schema' => ( | ||||
151 | is => 'rw', | ||||
152 | isa => 'Str', | ||||
153 | required => 0, | ||||
154 | init_arg => undef, | ||||
155 | ); | ||||
156 | |||||
157 | has _verbose_funcs => ( | ||||
158 | is => 'rw', | ||||
159 | isa => 'HashRef', | ||||
160 | required => 0, | ||||
161 | default => sub { {} }, | ||||
162 | ); | ||||
163 | |||||
164 | ############################################################################## | ||||
165 | |||||
166 | sub BUILD { | ||||
167 | 7 | my $self = shift; | |||
168 | |||||
169 | 7 | if ( defined $ENV{VERBOSE_FUNCS} ) { | |||
170 | 0 | my $vf = $self->_verbose_funcs; | |||
171 | |||||
172 | 0 | foreach my $func ( split /[,|:]/, $ENV{VERBOSE_FUNCS} ) { | |||
173 | 0 | $vf->{$func} = 1; | |||
174 | } | ||||
175 | |||||
176 | 0 | $self->_verbose_funcs($vf); | |||
177 | } | ||||
178 | |||||
179 | 7 | my $dbh = $self->dbh; | |||
180 | |||||
181 | 7 | if ( !$dbh ) { | |||
182 | |||||
183 | 4 | $dbh = DBI->connect( | |||
184 | $self->dsn, | ||||
185 | $self->user, | ||||
186 | $self->pass, | ||||
187 | { | ||||
188 | RaiseError => 1, | ||||
189 | FetchHashKeyName => 'NAME_uc', | ||||
190 | AutoCommit => 0, # dbd::mysql workaround | ||||
191 | PrintError => 0 | ||||
192 | } | ||||
193 | ); | ||||
194 | |||||
195 | 2 | $dbh->{AutoCommit} = 1; # dbd::mysql workarounda | |||
196 | } | ||||
197 | else { | ||||
198 | 3 | $dbh->{FetchHashKeyName} = 'NAME_uc'; | |||
199 | } | ||||
200 | |||||
201 | 5 | my $schema = $dbh->selectrow_arrayref("select schema()")->[0]; | |||
202 | 5 | if ($schema) { | |||
203 | 5 | $self->_schema($schema); | |||
204 | } | ||||
205 | |||||
206 | 5 | $self->_set_dbh($dbh); | |||
207 | } | ||||
208 | |||||
209 | ################################################################# | ||||
210 | #################### PRIVATE METHODS ############################ | ||||
211 | ################################################################# | ||||
212 | |||||
213 | #sub _get_ak_constraint_arrayref { | ||||
214 | # args | ||||
215 | # my $self => 'Object', | ||||
216 | # my $table => 'Str', | ||||
217 | # my $name => 'Str'; | ||||
218 | # | ||||
219 | # my $href = $self->get_ak_constraints($table); | ||||
220 | # | ||||
221 | # if (defined $href->{$name}) { | ||||
222 | # return $href->{$name}; | ||||
223 | # } | ||||
224 | # | ||||
225 | # confess "can't find ak constraint: $name"; | ||||
226 | #} | ||||
227 | |||||
228 | sub _get_fk_column { | ||||
229 | 246 | my $self = shift; | |||
230 | 246 | my %a = @_; | |||
231 | |||||
232 | 246 | my $table = $a{table} || confess "missing table arg"; | |||
233 | 246 | my $column = $a{column} || confess "missing column arg"; | |||
234 | |||||
235 | 246 | my $fks_href = $self->get_fk_constraints($table); | |||
236 | |||||
237 | 246 | foreach my $fk_name ( keys %$fks_href ) { | |||
238 | |||||
239 | 369 369 | foreach my $fk_href ( @{ $fks_href->{$fk_name} } ) { | |||
240 | |||||
241 | 369 | if ( $fk_href->{COLUMN_NAME} eq $column ) { | |||
242 | 246 | return $fk_href; | |||
243 | } | ||||
244 | } | ||||
245 | } | ||||
246 | |||||
247 | 0 | confess "couldn't find where $table.$column is part of an fk?"; | |||
248 | } | ||||
249 | |||||
250 | sub _get_indexes_arrayref { | ||||
251 | 10 | my $self = shift; | |||
252 | 10 | my $table = shift; | |||
253 | |||||
254 | 10 | my $cache = '_index_cache'; | |||
255 | |||||
256 | 10 | if ( defined( $self->$cache->{$table} ) ) { | |||
257 | 5 | return $self->$cache->{$table}->data; | |||
258 | } | ||||
259 | |||||
260 | 5 | my $dbh = $self->_dbh; | |||
261 | 5 | my $sth = $dbh->prepare("show indexes in $table"); | |||
262 | 5 | $sth->execute; | |||
263 | |||||
264 | 4 | my $aref = []; | |||
265 | 4 | while ( my $href = $sth->fetchrow_hashref ) { | |||
266 | 11 | push( @$aref, {%$href} ); | |||
267 | } | ||||
268 | |||||
269 | 4 | $self->$cache->{$table} = MySQL::Util::Data::Cache->new( data => $aref ); | |||
270 | 4 | return $aref; | |||
271 | } | ||||
272 | |||||
273 | sub _fq { | ||||
274 | 9199 | args | |||
275 | |||||
276 | # required | ||||
277 | my $self => 'Object', | ||||
278 | my $table => 'Str', | ||||
279 | |||||
280 | # optional | ||||
281 | my $fq => { isa => 'Int', optional => 1, default => 1 }, | ||||
282 | my $schema => { isa => 'Str|Undef', optional => 1 }; | ||||
283 | |||||
284 | 9199 | if ($fq) { | |||
285 | 9127 | if ( $table =~ /\w\.\w/ ) { | |||
286 | 6791 | return $table; | |||
287 | } | ||||
288 | elsif ($schema) { | ||||
289 | 1076 | return "$schema.$table"; | |||
290 | } | ||||
291 | |||||
292 | 1260 | return $self->_schema . ".$table"; | |||
293 | } | ||||
294 | |||||
295 | 72 | if ( $table =~ /^(\w+)\.(\w+)$/ ) { | |||
296 | 72 | my $curr = $self->_schema; | |||
297 | |||||
298 | 72 | confess "can't remove schema name from table name $table because we " | |||
299 | . "are not in the same db context (incoming fq table = $table, " | ||||
300 | . "current schema = $curr" | ||||
301 | if $curr ne $1; | ||||
302 | |||||
303 | 72 | return $2; | |||
304 | } | ||||
305 | |||||
306 | 0 | return $table; | |||
307 | } | ||||
308 | |||||
309 | sub _un_fq { | ||||
310 | 45 | args_pos | |||
311 | |||||
312 | # required | ||||
313 | my $self => 'Object', | ||||
314 | my $table => 'Str'; | ||||
315 | |||||
316 | 45 | if ( $table =~ /^(\w+)\.(\w+)$/ ) { | |||
317 | 45 | return ( $1, $2 ); | |||
318 | } | ||||
319 | |||||
320 | 0 | return ( $self->_schema, $table ); | |||
321 | } | ||||
322 | |||||
323 | sub _get_fk_ddl { | ||||
324 | 5 | my $self = shift; | |||
325 | 5 | my $table = shift; | |||
326 | 5 | my $fk = shift; | |||
327 | |||||
328 | 5 | my $sql = "show create table $table"; | |||
329 | 5 | my $sth = $self->_dbh->prepare($sql); | |||
330 | 5 | $sth->execute; | |||
331 | |||||
332 | 5 | while ( my @a = $sth->fetchrow_array ) { | |||
333 | |||||
334 | 5 | foreach my $data (@a) { | |||
335 | 10 | my @b = split( /\n/, $data ); | |||
336 | |||||
337 | 10 | foreach my $item (@b) { | |||
338 | 41 | if ( $item =~ /CONSTRAINT `$fk` FOREIGN KEY/ ) { | |||
339 | 5 | $item =~ s/^\s*//; # remove leading ws | |||
340 | 5 | $item =~ s/\s*//; # remove trailing ws | |||
341 | 5 | $item =~ s/,$//; # remove trailing comma | |||
342 | |||||
343 | 5 | return "alter table $table add $item"; | |||
344 | } | ||||
345 | } | ||||
346 | } | ||||
347 | } | ||||
348 | } | ||||
349 | |||||
350 | sub _column_exists { | ||||
351 | 259 | my $self = shift; | |||
352 | 259 | my %a = @_; | |||
353 | |||||
354 | 259 | my $table = $a{table} or confess "missing table arg"; | |||
355 | 259 | my $column = $a{column} or confess "missing column arg"; | |||
356 | |||||
357 | 259 | my $desc_aref = $self->describe_table($table); | |||
358 | |||||
359 | 259 | foreach my $col_href (@$desc_aref) { | |||
360 | |||||
361 | 302 | if ( $col_href->{FIELD} eq $column ) { | |||
362 | 259 | return 1; | |||
363 | } | ||||
364 | } | ||||
365 | |||||
366 | 0 | return 0; | |||
367 | } | ||||
368 | |||||
369 | sub _verbose { | ||||
370 | 6122 | args_pos | |||
371 | |||||
372 | # required | ||||
373 | my $self => 'Object', | ||||
374 | my $msg => 'Str', | ||||
375 | |||||
376 | # optional | ||||
377 | my $func_counter => { isa => 'Str', default => 0, optional => 1 }; | ||||
378 | |||||
379 | 6122 | my $caller_func = ( caller(1) )[3]; | |||
380 | 6122 | my $caller_line = ( caller(0) )[2]; | |||
381 | |||||
382 | 6122 | my @caller_func = split( /\::/, $caller_func ); | |||
383 | 6122 | my $key = pop @caller_func; | |||
384 | |||||
385 | 6122 | if ( $self->_verbose_funcs->{$key} ) { | |||
386 | 0 | print STDERR "[VERBOSE] $caller_func ($caller_line) "; | |||
387 | 0 | print STDERR "[cnt=$func_counter]" if $func_counter; | |||
388 | 0 | print STDERR "\n"; | |||
389 | |||||
390 | 0 | chomp $msg; | |||
391 | 0 | foreach my $nl ( split /\n/, $msg ) { | |||
392 | 0 | print STDERR "\t$nl\n"; | |||
393 | } | ||||
394 | } | ||||
395 | } | ||||
396 | |||||
397 | sub _verbose_sql { | ||||
398 | 212 | args_pos | |||
399 | |||||
400 | # required | ||||
401 | my $self => 'Object', | ||||
402 | my $sql => 'Str', | ||||
403 | |||||
404 | # optional | ||||
405 | my $func_counter => { isa => 'Int', default => 0, optional => 1 }; | ||||
406 | |||||
407 | 212 | my $caller_func = ( caller(1) )[3]; | |||
408 | 212 | my $caller_line = ( caller(0) )[2]; | |||
409 | |||||
410 | 212 | my @caller_func = split( /\::/, $caller_func ); | |||
411 | 212 | my $key = pop @caller_func; | |||
412 | |||||
413 | 212 | if ( $self->_verbose_funcs->{$key} ) { | |||
414 | 0 | print STDERR "[VERBOSE] $caller_func ($caller_line) "; | |||
415 | 0 | print STDERR "[cnt=$func_counter]" if $func_counter; | |||
416 | 0 | print STDERR "\n"; | |||
417 | |||||
418 | 0 | $sql = SQL::Beautify->new( query => $sql )->beautify; | |||
419 | 0 | foreach my $l ( split /\n/, $sql ) { | |||
420 | 0 | print STDERR "\t$l\n"; | |||
421 | } | ||||
422 | } | ||||
423 | } | ||||
424 | |||||
425 | ################################################################# | ||||
426 | ##################### PUBLIC METHODS ############################ | ||||
427 | ################################################################# | ||||
428 | |||||
429 - 446 | =head1 METHODS All methods croak in the event of failure unless otherwise noted. =over =item new( dsn => $dsn, user => $user, [pass => $pass], [span => $span]); constructor * dsn - standard DBI stuff * user - db username * pass - db password * span - follow references that span databases (default 0) =cut | ||||
447 | |||||
448 - 455 | =item apply_ddl( [ ... ]) Runs arbitrary ddl commands passed in via an array ref. The advantage of this is it allows you to make ddl changes to the db without having to worry about the object's internal cache (see clear_cache()). =cut | ||||
456 | |||||
457 | sub apply_ddl { | ||||
458 | 1 | args_pos | |||
459 | |||||
460 | # required | ||||
461 | my $self => 'Object', | ||||
462 | my $stmts_aref => 'ArrayRef'; | ||||
463 | |||||
464 | 1 | foreach my $stmt (@$stmts_aref) { | |||
465 | 5 | $self->_dbh->do($stmt); | |||
466 | } | ||||
467 | |||||
468 | 1 | $self->clear_cache; | |||
469 | } | ||||
470 | |||||
471 - 486 | =item describe_column(table => $table, column => $column) Returns a hashref for the requested column. Hash elements for each column: DEFAULT EXTRA FIELD KEY NULL TYPE See MySQL documentation for more info on "describe <table>". =cut | ||||
487 | |||||
488 | sub describe_column { | ||||
489 | 259 | args | |||
490 | |||||
491 | # required | ||||
492 | my $self => 'Object', | ||||
493 | my $table => 'Str', | ||||
494 | my $column => 'Str'; | ||||
495 | |||||
496 | 259 | if ( !$self->_column_exists( table => $table, column => $column ) ) { | |||
497 | 0 | confess "column $column does not exist in table $table"; | |||
498 | } | ||||
499 | |||||
500 | 259 | my $col_aref = $self->describe_table($table); | |||
501 | |||||
502 | 259 | foreach my $col_href (@$col_aref) { | |||
503 | 302 | if ( $col_href->{FIELD} =~ /^$column$/i ) { | |||
504 | 259 | return $col_href; | |||
505 | } | ||||
506 | } | ||||
507 | } | ||||
508 | |||||
509 - 528 | =item describe_table($table) Returns an arrayref of column info for a given table. The structure of the returned data is: $arrayref->[ { col1 }, { col2 } ] Hash elements for each column: DEFAULT EXTRA FIELD KEY NULL TYPE See MySQL documentation for more info on "describe <table>". =cut | ||||
529 | |||||
530 | sub describe_table { | ||||
531 | 1646 | my $self = shift; | |||
532 | 1646 | my $table = shift; | |||
533 | |||||
534 | 1646 | $table = $self->_fq( table => $table, fq => 1 ); | |||
535 | |||||
536 | 1646 | my $cache = '_describe_cache'; | |||
537 | |||||
538 | 1646 | if ( defined( $self->$cache->{$table} ) ) { | |||
539 | 1631 | return $self->$cache->{$table}->data; | |||
540 | } | ||||
541 | |||||
542 | 15 | my $sql = qq{ | |||
543 | describe $table | ||||
544 | }; | ||||
545 | |||||
546 | 15 | my $dbh = $self->_dbh; | |||
547 | 15 | my $sth = $dbh->prepare($sql); | |||
548 | 15 | $sth->execute; | |||
549 | |||||
550 | 15 | my @cols; | |||
551 | 15 | while ( my $row = $sth->fetchrow_hashref ) { | |||
552 | 29 | push( @cols, {%$row} ); | |||
553 | } | ||||
554 | |||||
555 | 15 | $self->$cache->{$table} = MySQL::Util::Data::Cache->new( data => \@cols ); | |||
556 | 15 | return \@cols; | |||
557 | } | ||||
558 | |||||
559 - 567 | =item drop_fks([$table]) Drops foreign keys for a given table or the entire database if no table is provided. Returns an array ref of alter table statements to rebuild the dropped foreign keys on success. Returns an empty array ref if no foreign keys were found. =cut | ||||
568 | |||||
569 | sub drop_fks { | ||||
570 | 1 | my $self = shift; | |||
571 | 1 | my $table = shift; | |||
572 | |||||
573 | 1 | my @tables; | |||
574 | 1 | if ( !defined($table) ) { | |||
575 | 1 | my $tables_aref = $self->get_tables; | |||
576 | 1 | return [] if !defined($tables_aref); | |||
577 | |||||
578 | 1 | @tables = @$tables_aref; | |||
579 | } | ||||
580 | else { | ||||
581 | 0 | push( @tables, $table ); | |||
582 | } | ||||
583 | |||||
584 | 1 | my @ret; | |||
585 | 1 | foreach my $table (@tables) { | |||
586 | |||||
587 | 9 | my $fqtn = $self->_schema . ".$table"; | |||
588 | 9 | my $fks_href = $self->get_fk_constraints($table); | |||
589 | |||||
590 | 9 | foreach my $fk ( keys %$fks_href ) { | |||
591 | |||||
592 | 5 | push( @ret, $self->_get_fk_ddl( $table, $fk ) ); | |||
593 | |||||
594 | 5 | my $sql = qq{ | |||
595 | alter table $table | ||||
596 | drop foreign key $fk | ||||
597 | }; | ||||
598 | 5 | $self->_dbh->do($sql); | |||
599 | |||||
600 | 5 | $self->_constraint_cache->{$fqtn} = undef; | |||
601 | } | ||||
602 | } | ||||
603 | |||||
604 | 1 | return [@ret]; | |||
605 | } | ||||
606 | |||||
607 - 619 | =item get_ak_constraints($table) Returns a hashref of the alternate key constraints for a given table. Returns an empty hashref if none were found. The primary key is excluded from the returned data. The structure of the returned data is: $hashref->{constraint_name}->[ { col1 }, { col2 } ] See "get_constraints" for a list of the hash elements in each column. =cut | ||||
620 | |||||
621 | sub get_ak_constraints { | ||||
622 | 227 | my $self = shift; | |||
623 | 227 | my $table = shift or confess "missing table arg"; | |||
624 | |||||
625 | 226 | $table = $self->_fq( table => $table, fq => 1 ); | |||
626 | |||||
627 | 226 | my $cons = $self->get_constraints($table); | |||
628 | |||||
629 | 224 | my $ret; | |||
630 | 224 | foreach my $con_name ( keys(%$cons) ) { | |||
631 | 451 | if ( $cons->{$con_name}->[0]->{CONSTRAINT_TYPE} eq 'UNIQUE' ) { | |||
632 | 11 | $ret->{$con_name} = $cons->{$con_name}; | |||
633 | } | ||||
634 | } | ||||
635 | |||||
636 | 224 | return $ret; | |||
637 | } | ||||
638 | |||||
639 - 650 | =item get_ak_indexes($table) Returns a hashref of the alternate key indexes for a given table. Returns an empty hashref if one was not found. The structure of the returned data is: $href->{index_name}->[ { col1 }, { col2 } ] See get_indexes for a list of hash elements in each column. =cut | ||||
651 | |||||
652 | sub get_ak_indexs { | ||||
653 | |||||
654 | # for backwards compatibility | ||||
655 | 1 | my $self = shift; | |||
656 | 1 | return $self->get_ak_indexes(@_); | |||
657 | } | ||||
658 | |||||
659 | sub get_ak_indexes { | ||||
660 | 4 | args_pos my $self => 'Object', | |||
661 | my $table => 'Str'; | ||||
662 | |||||
663 | 3 | if ( $table !~ /\./ ) { | |||
664 | 2 | $table = $self->_schema . ".$table"; | |||
665 | } | ||||
666 | |||||
667 | 3 | my $href = {}; | |||
668 | 3 | my $indexes = $self->get_indexes($table); | |||
669 | |||||
670 | 3 | foreach my $index ( keys(%$indexes) ) { | |||
671 | 15 | if ( $indexes->{$index}->[0]->{NON_UNIQUE} == 0 ) { | |||
672 | 9 | $href->{$index} = $indexes->{$index}; | |||
673 | } | ||||
674 | } | ||||
675 | |||||
676 | 3 | return $href; | |||
677 | } | ||||
678 | |||||
679 - 684 | =item get_ak_names($table) Returns an arrayref of alternate key constraints. Returns undef if none were found. =cut | ||||
685 | |||||
686 | sub get_ak_names { | ||||
687 | 2 | my $self = shift; | |||
688 | 2 | my $table = shift || confess "missing table arg"; | |||
689 | |||||
690 | 1 | if ( $self->has_ak($table) ) { | |||
691 | 1 | my $href = $self->get_ak_constraints($table); | |||
692 | 1 | return ( keys %$href ); | |||
693 | } | ||||
694 | |||||
695 | 0 | return; | |||
696 | } | ||||
697 | |||||
698 - 711 | =item get_constraint(table => $table, name => $constraint_name) Returns an arrayref for the requested constraints on a given table. Throws an error if the constraint is not found. The structure of the returned data is: $arrayref->[ { col1 }, { col2 } ] Hash elements for each column: see get_constraints() =cut | ||||
712 | |||||
713 | sub get_constraint { | ||||
714 | 55 | args | |||
715 | |||||
716 | # required | ||||
717 | my $self => 'Object', | ||||
718 | my $name => 'Str', | ||||
719 | |||||
720 | # optional | ||||
721 | my $schema => { isa => 'Str', optional => 1 }, | ||||
722 | my $table => { isa => 'Str', optional => 1 }; | ||||
723 | |||||
724 | 55 | my ( $unfq_schema, $unfq_table, $fq_table ); | |||
725 | |||||
726 | 55 | if ( defined $table ) { | |||
727 | 45 | ( $unfq_schema, $unfq_table ) = $self->_un_fq($table); | |||
728 | 45 | if ($schema) { | |||
729 | 0 | if ( $unfq_schema ne $schema ) { | |||
730 | 0 | confess "schema arg $schema does not match table $table"; | |||
731 | } | ||||
732 | } | ||||
733 | |||||
734 | 45 | $fq_table = $self->_fq( | |||
735 | table => $unfq_table, | ||||
736 | fq => 1, | ||||
737 | schema => $unfq_schema | ||||
738 | ); | ||||
739 | } | ||||
740 | |||||
741 | 55 | if ( defined $fq_table ) { | |||
742 | 45 | my $cons_href = $self->get_constraints($fq_table); | |||
743 | |||||
744 | 45 | foreach my $cons_name ( keys %$cons_href ) { | |||
745 | 46 | if ( $cons_name eq $name ) { | |||
746 | 45 | return $cons_href->{$cons_name}; | |||
747 | } | ||||
748 | } | ||||
749 | |||||
750 | 0 | confess "failed to find constraint $name for table $fq_table"; | |||
751 | } | ||||
752 | |||||
753 | 10 | $schema = $self->_schema if !$schema; | |||
754 | |||||
755 | # | ||||
756 | # search cache for the constraint name across tables | ||||
757 | # | ||||
758 | 10 | my $cache = '_constraint_cache'; | |||
759 | |||||
760 | 10 10 | foreach my $t ( keys %{ $self->$cache } ) { | |||
761 | |||||
762 | 18 | if ( defined( $self->$cache->{$t} ) ) { | |||
763 | 18 | my $data_href = $self->$cache->{$t}->data; | |||
764 | |||||
765 | 18 | foreach my $cons_name ( keys %$data_href ) { | |||
766 | 30 | if ( $cons_name eq $name ) { | |||
767 | |||||
768 | 10 | return $data_href->{$cons_name}; | |||
769 | } | ||||
770 | } | ||||
771 | } | ||||
772 | } | ||||
773 | |||||
774 | 0 | my $sql = qq{ | |||
775 | select distinct tc.table_name | ||||
776 | from information_schema.table_constraints tc | ||||
777 | where tc.constraint_schema = '$schema' | ||||
778 | }; | ||||
779 | |||||
780 | 0 | if ( !$self->span ) { | |||
781 | 0 | $sql .= qq{ | |||
782 | and (referenced_table_schema = '$schema' or referenced_table_schema is null) | ||||
783 | }; | ||||
784 | } | ||||
785 | |||||
786 | 0 | my $dbh = $self->_dbh; | |||
787 | 0 | my $sth = $dbh->prepare($sql); | |||
788 | 0 | $sth->execute; | |||
789 | |||||
790 | 0 | while ( my ($t) = $sth->fetchrow_array ) { | |||
791 | 0 | my $cons_href = $self->get_constraints( table => $t ); | |||
792 | |||||
793 | 0 | foreach my $cons_name ( keys %$cons_href ) { | |||
794 | 0 | if ( $cons_name eq $name ) { | |||
795 | 0 | $sth->finish; | |||
796 | 0 | return $cons_href->{$cons_name}; | |||
797 | } | ||||
798 | } | ||||
799 | } | ||||
800 | |||||
801 | 0 | confess "failed to find constraint name $name"; | |||
802 | } | ||||
803 | |||||
804 - 826 | =item get_constraints($table) Returns a hashref of the constraints for a given table. Returns an empty hashref if none were found. The structure of the returned data is: $hashref->{constraint_name}->[ { col1 }, { col2 } ] Hash elements for each column: CONSTRAINT_NAME TABLE_NAME CONSTRAINT_SCHEMA CONSTRAINT_TYPE COLUMN_NAME ORDINAL_POSITION POSITION_IN_UNIQUE_CONSTRAINT REFERENCED_COLUMN_NAME REFERENCED_TABLE_SCHEMA REFERENCED_TABLE_NAME =cut | ||||
827 | |||||
828 | sub get_constraints { | ||||
829 | 3460 | my $self = shift; | |||
830 | 3460 | my $table = shift || confess "missing table arg"; | |||
831 | |||||
832 | 3460 | $table = $self->_fq( table => $table, fq => 1 ); | |||
833 | |||||
834 | 3460 | my ( $schema, $table_no_schema ) = split( /\./, $table ); | |||
835 | |||||
836 | 3460 | my $cache = '_constraint_cache'; | |||
837 | |||||
838 | 3460 | if ( defined( $self->$cache->{$table} ) ) { | |||
839 | 3418 | return $self->$cache->{$table}->data; | |||
840 | } | ||||
841 | |||||
842 | 42 | confess "table '$table' does not exist: " if !$self->table_exists($table); | |||
843 | |||||
844 | 36 | my $sql = qq{ | |||
845 | select kcu.constraint_name, tc.constraint_type, column_name, | ||||
846 | ordinal_position, position_in_unique_constraint, referenced_table_schema, | ||||
847 | referenced_table_name, referenced_column_name, tc.constraint_schema | ||||
848 | from information_schema.table_constraints tc, | ||||
849 | information_schema.key_column_usage kcu | ||||
850 | where tc.table_name = '$table_no_schema' | ||||
851 | and tc.table_name = kcu.table_name | ||||
852 | and tc.constraint_name = kcu.constraint_name | ||||
853 | and tc.constraint_schema = '$schema' | ||||
854 | and kcu.constraint_schema = tc.constraint_schema | ||||
855 | }; | ||||
856 | |||||
857 | 36 | if ( !$self->span ) { | |||
858 | 36 | $sql .= qq{ | |||
859 | and (referenced_table_schema = '$schema' or referenced_table_schema is null) | ||||
860 | }; | ||||
861 | } | ||||
862 | |||||
863 | 36 | $sql .= qq{ order by constraint_name, ordinal_position }; | |||
864 | |||||
865 | 36 | my $dbh = $self->_dbh; | |||
866 | 36 | my $sth = $dbh->prepare($sql); | |||
867 | 36 | $sth->execute; | |||
868 | |||||
869 | 36 | my $href = {}; | |||
870 | 36 | while ( my $row = $sth->fetchrow_hashref ) { | |||
871 | |||||
872 | 72 | my $name = $row->{CONSTRAINT_NAME}; | |||
873 | 72 63 | if ( !defined( $href->{$name} ) ) { $href->{$name} = [] } | |||
874 | |||||
875 | 72 | $row->{TABLE_NAME} = $self->_fq( table => $table, fq => 0 ); | |||
876 | |||||
877 | 72 72 | push( @{ $href->{$name} }, {%$row} ); | |||
878 | } | ||||
879 | |||||
880 | 36 | $self->$cache->{$table} = MySQL::Util::Data::Cache->new( data => $href ); | |||
881 | 36 | return $href; | |||
882 | } | ||||
883 | |||||
884 - 888 | =item get_dbname() Returns the name of the current schema/database. =cut | ||||
889 | |||||
890 | sub get_dbname { | ||||
891 | 8 | my $self = shift; | |||
892 | 8 | confess "get_dbname does not take any parameters" if @_; | |||
893 | |||||
894 | 7 | return $self->_schema; | |||
895 | } | ||||
896 | |||||
897 - 916 | =item get_depth($table) Returns the table depth within the data model hierarchy. The depth is zero based. For example: =for text ----------- ----------- | table A |------<| table B | ----------- ----------- Table A has a depth of 0 and table B has a depth of 1. In other words, table B is one level down in the model hierarchy. If a table has multiple parents, the parent with the highest depth wins. =cut | ||||
917 | |||||
918 | sub get_depth { | ||||
919 | 290 | my $self = shift; | |||
920 | 290 | my $table = shift or confess "missing table arg"; | |||
921 | |||||
922 | 289 | if ( $table !~ /\./ ) { | |||
923 | 15 | $table = $self->_schema . ".$table"; | |||
924 | } | ||||
925 | |||||
926 | 289 | my $cache = '_depth_cache'; | |||
927 | |||||
928 | 289 | if ( defined( $self->{$cache}->{$table} ) ) { | |||
929 | 270 | return $self->{$cache}->{$table}; | |||
930 | } | ||||
931 | |||||
932 | 19 | my $dbh = $self->_dbh; | |||
933 | |||||
934 | 19 | my $fk_cons = $self->get_fk_constraints($table); | |||
935 | |||||
936 | 18 | my $depth = 0; | |||
937 | |||||
938 | 18 | foreach my $fk_name ( keys(%$fk_cons) ) { | |||
939 | 12 | my $parent_table = | |||
940 | $fk_cons->{$fk_name}->[0]->{REFERENCED_TABLE_SCHEMA} . '.' | ||||
941 | . $fk_cons->{$fk_name}->[0]->{REFERENCED_TABLE_NAME}; | ||||
942 | |||||
943 | 12 0 | if ( $parent_table eq $table ) { next } # self referencing table | |||
944 | |||||
945 | 12 | my $parent_depth = $self->get_depth($parent_table); | |||
946 | 12 9 | if ( $parent_depth >= $depth ) { $depth = $parent_depth + 1 } | |||
947 | } | ||||
948 | |||||
949 | 18 | $self->{$cache}->{$table} = $depth; | |||
950 | |||||
951 | 18 | return $depth; | |||
952 | } | ||||
953 | |||||
954 - 960 | =item get_fk_column_names(table => $table, [name => $constraint_name]) If name is specified, returns an array of columns that participate in the foreign key constraint. If name is not specified, returns an array of columns that participate an any foreign key constraint on the table. =cut | ||||
961 | |||||
962 | sub get_fk_column_names { | ||||
963 | 215 | args | |||
964 | |||||
965 | # required | ||||
966 | my $self => 'Object', | ||||
967 | my $table => 'Str', | ||||
968 | |||||
969 | # optional | ||||
970 | my $name => { isa => 'Str', optional => 1 }; | ||||
971 | |||||
972 | 215 | $table = $self->_fq( table => $table, fq => 1 ); | |||
973 | |||||
974 | 215 | my @columns; | |||
975 | |||||
976 | 215 | my $fks_href = $self->get_fk_constraints($table); | |||
977 | |||||
978 | 215 | foreach my $fk_name ( keys %$fks_href ) { | |||
979 | |||||
980 | 210 | next if ( $name and $name ne $fk_name ); | |||
981 | |||||
982 | 210 210 | foreach my $fk_href ( @{ $fks_href->{$fk_name} } ) { | |||
983 | |||||
984 | 210 | my $col = $fk_href->{COLUMN_NAME}; | |||
985 | 210 | push( @columns, $col ); | |||
986 | } | ||||
987 | } | ||||
988 | |||||
989 | 215 | return @columns; | |||
990 | } | ||||
991 | |||||
992 - 1005 | =item get_fk_constraints([$table]) Returns the foreign keys for a table or the entire database. Returns a hashref of the foreign key constraints on success. Returns an empty hashref if none were found. The structure of the returned data is: $hashref->{constraint_name}->[ { col1 }, { col2 } ] See "get_constraints" for a list of the hash elements in each column. =cut | ||||
1006 | |||||
1007 | sub get_fk_constraints { | ||||
1008 | 2317 | args_pos | |||
1009 | |||||
1010 | # required | ||||
1011 | my $self => 'Object', | ||||
1012 | |||||
1013 | # optional | ||||
1014 | my $table => { isa => 'Str', optional => 1 }; | ||||
1015 | |||||
1016 | 2317 | if ( defined($table) and $table !~ /\./ ) { | |||
1017 | 252 | $table = $self->_schema . ".$table"; | |||
1018 | } | ||||
1019 | |||||
1020 | 2317 | my @tables; | |||
1021 | 2317 | if ( !defined($table) ) { | |||
1022 | 3 | my $tables_aref = $self->get_tables; | |||
1023 | 3 | return {} if !defined($tables_aref); | |||
1024 | |||||
1025 | 3 | @tables = @$tables_aref; | |||
1026 | } | ||||
1027 | else { | ||||
1028 | 2314 | push( @tables, $table ); | |||
1029 | } | ||||
1030 | |||||
1031 | 2317 | my $href = {}; | |||
1032 | |||||
1033 | 2317 | foreach my $table (@tables) { | |||
1034 | |||||
1035 | 2341 | my $cons_href = $self->get_constraints($table); | |||
1036 | 2338 | foreach my $cons_name ( keys(%$cons_href) ) { | |||
1037 | |||||
1038 | 4811 | my $cons_aref = $cons_href->{$cons_name}; | |||
1039 | 4811 | foreach my $col_href (@$cons_aref) { | |||
1040 | |||||
1041 | 5695 | my $type = $col_href->{CONSTRAINT_TYPE}; | |||
1042 | |||||
1043 | 5695 | if ( $type eq 'FOREIGN KEY' ) { | |||
1044 | 2453 | $href->{$cons_name} = [@$cons_aref]; | |||
1045 | } | ||||
1046 | } | ||||
1047 | } | ||||
1048 | } | ||||
1049 | |||||
1050 | 2314 | return $href; | |||
1051 | } | ||||
1052 | |||||
1053 - 1065 | =item get_fk_indexes($table) Returns a hashref of the foreign key indexes for a given table. Returns an empty hashref if none were found. In order to qualify as a fk index, it must have a corresponding fk constraint. The structure of the returned data is: $hashref->{index_name}->[ { col1 }, { col2 } ] See "get_indexes" for a list of the hash elements in each column. =cut | ||||
1066 | |||||
1067 | sub get_fk_indexes { | ||||
1068 | 3 | args_pos my $self => 'Object', | |||
1069 | my $table => 'Str'; | ||||
1070 | |||||
1071 | 2 | if ( $table !~ /\./ ) { | |||
1072 | 1 | $table = $self->_schema . ".$table"; | |||
1073 | } | ||||
1074 | |||||
1075 | 2 | my $href = {}; | |||
1076 | 2 | my $cons = $self->get_fk_constraints($table); | |||
1077 | 2 | my $indexes = $self->get_indexes($table); | |||
1078 | |||||
1079 | 2 | foreach my $con_name ( keys(%$cons) ) { | |||
1080 | 2 2 | my @con_cols = @{ $cons->{$con_name} }; | |||
1081 | |||||
1082 | 2 | foreach my $index_name ( keys(%$indexes) ) { | |||
1083 | 6 6 | my @index_cols = @{ $indexes->{$index_name} }; | |||
1084 | |||||
1085 | 6 | if ( scalar(@con_cols) == scalar(@index_cols) ) { | |||
1086 | |||||
1087 | 6 | my $match = 1; | |||
1088 | 6 | for ( my $i = 0 ; $i < scalar(@con_cols) ; $i++ ) { | |||
1089 | 6 | if ( $index_cols[$i]->{COLUMN_NAME} ne | |||
1090 | $con_cols[$i]->{COLUMN_NAME} ) | ||||
1091 | { | ||||
1092 | 4 | $match = 0; | |||
1093 | 4 | last; | |||
1094 | } | ||||
1095 | } | ||||
1096 | |||||
1097 | 6 | if ($match) { | |||
1098 | 2 | $href->{$index_name} = $indexes->{$index_name}; | |||
1099 | 2 | last; | |||
1100 | } | ||||
1101 | } | ||||
1102 | } | ||||
1103 | } | ||||
1104 | |||||
1105 | 2 | return $href; | |||
1106 | } | ||||
1107 | |||||
1108 - 1132 | =item get_indexes($table) Returns a hashref of the indexes for a given table. Returns an empty hashref if none were found. The structure of the returned data is: $href->{index_name}->[ { col1 }, { col2 } ] Hash elements for each column: CARDINALITY COLLATION COLUMN_NAME COMMENT INDEX_TYPE KEY_NAME NON_UNIQUE NULL PACKED SEQ_IN_INDEX SUB_PART TABLE =cut | ||||
1133 | |||||
1134 | sub get_indexes { | ||||
1135 | 12 | my $self = shift; | |||
1136 | 12 | my $table = shift or confess "missing table arg"; | |||
1137 | |||||
1138 | 10 | if ( $table !~ /\./ ) { | |||
1139 | 4 | $table = $self->_schema . ".$table"; | |||
1140 | } | ||||
1141 | |||||
1142 | 10 | my %h = (); | |||
1143 | 10 | my $indexes = $self->_get_indexes_arrayref($table); | |||
1144 | |||||
1145 | 9 | foreach my $index (@$indexes) { | |||
1146 | 41 | my $key_name = $index->{KEY_NAME}; | |||
1147 | 41 | my $seq = $index->{SEQ_IN_INDEX}; | |||
1148 | |||||
1149 | 41 34 | if ( !exists( $h{$key_name} ) ) { $h{$key_name} = [] } | |||
1150 | |||||
1151 | 41 | $h{$key_name}->[ $seq - 1 ] = $index; | |||
1152 | } | ||||
1153 | |||||
1154 | 9 | return \%h; | |||
1155 | } | ||||
1156 | |||||
1157 - 1163 | =item get_max_depth() Returns the max table depth for all tables in the database. See "get_depth" for additional info. =cut | ||||
1164 | |||||
1165 | sub get_max_depth { | ||||
1166 | 1 | my $self = shift; | |||
1167 | |||||
1168 | 1 | my $dbh = $self->_dbh; | |||
1169 | |||||
1170 | 1 | my $tables = $self->get_tables(); | |||
1171 | |||||
1172 | 1 | my $max = 0; | |||
1173 | 1 | foreach my $table (@$tables) { | |||
1174 | 9 | my $depth = $self->get_depth($table); | |||
1175 | 9 3 | if ( $depth > $max ) { $max = $depth } | |||
1176 | } | ||||
1177 | |||||
1178 | 1 | return $max; | |||
1179 | } | ||||
1180 | |||||
1181 - 1192 | =item get_other_constraints($table) Returns a hashref of the constraints that are not pk, ak, or fk for a given table. Returns an empty hashref if none were found. The structure of the returned data is: $hashref->{constraint_name}->[ { col1 }, { col2 } ] See "get_constraints" for a list of the hash elements in each column. =cut | ||||
1193 | |||||
1194 | sub get_other_constraints { | ||||
1195 | 2 | args_pos my $self => 'Object', | |||
1196 | my $table => 'Str'; | ||||
1197 | |||||
1198 | 1 | if ( $table !~ /\./ ) { | |||
1199 | 1 | $table = $self->_schema . ".$table"; | |||
1200 | } | ||||
1201 | |||||
1202 | 1 | my $fk = $self->get_fk_constraints($table); | |||
1203 | 1 | my $ak = $self->get_ak_constraints($table); | |||
1204 | |||||
1205 | 1 | my $href = {}; | |||
1206 | 1 | my $cons = $self->get_constraints($table); | |||
1207 | |||||
1208 | 1 | foreach my $con_name ( keys(%$cons) ) { | |||
1209 | 4 | my $type = $cons->{$con_name}->[0]->{CONSTRAINT_TYPE}; | |||
1210 | |||||
1211 | 4 | next if $type eq 'PRIMARY KEY'; | |||
1212 | 3 | next if $type eq 'FOREIGN KEY'; | |||
1213 | 2 | next if $type eq 'UNIQUE'; | |||
1214 | |||||
1215 | 0 | $href->{$con_name} = $cons->{$con_name}; | |||
1216 | } | ||||
1217 | |||||
1218 | 1 | return $href; | |||
1219 | } | ||||
1220 | |||||
1221 - 1232 | =item get_other_indexes($table) Returns a hashref of the indexes that are not pk, ak, or fk for a given table. Returns an empty hashref if none were found. The structure of the returned data is: $hashref->{index_name}->[ { col1 }, { col2 } ] See "get_indexes" for a list of the hash elements in each column. =cut | ||||
1233 | |||||
1234 | sub get_other_indexes { | ||||
1235 | 2 | args_pos | |||
1236 | |||||
1237 | # required | ||||
1238 | my $self => 'Object', | ||||
1239 | my $table => 'Str'; | ||||
1240 | |||||
1241 | 1 | if ( $table !~ /\./ ) { | |||
1242 | 1 | $table = $self->_schema . ".$table"; | |||
1243 | } | ||||
1244 | |||||
1245 | 1 | my $ak = $self->get_ak_indexes($table); | |||
1246 | 1 | my $fk = $self->get_fk_indexes($table); | |||
1247 | |||||
1248 | 1 | my $href = {}; | |||
1249 | 1 | my $indexes = $self->get_indexes($table); | |||
1250 | |||||
1251 | 1 | foreach my $name ( keys %$indexes ) { | |||
1252 | 5 | next if $name eq 'PRIMARY'; | |||
1253 | 4 | next if defined( $ak->{$name} ); | |||
1254 | 2 | next if defined( $fk->{$name} ); | |||
1255 | |||||
1256 | 1 | $href->{$name} = $indexes->{$name}; | |||
1257 | } | ||||
1258 | |||||
1259 | 1 | return $href; | |||
1260 | } | ||||
1261 | |||||
1262 - 1273 | =item get_pk_constraint($table) Returns an arrayref of the primary key constraint for a given table. Returns an empty arrayref if none were found. The structure of the returned data is: $aref->[ { col1 }, { col2 }, ... ] See "get_constraints" for a list of hash elements in each column. =cut | ||||
1274 | |||||
1275 | sub get_pk_constraint { | ||||
1276 | 765 | my $self = shift; | |||
1277 | 765 | my $table = shift; | |||
1278 | |||||
1279 | 765 | if ( $table !~ /\./ ) { | |||
1280 | 0 | $table = $self->_schema . ".$table"; | |||
1281 | } | ||||
1282 | |||||
1283 | 765 | my $cons = $self->get_constraints($table); | |||
1284 | |||||
1285 | 764 | foreach my $con_name ( keys(%$cons) ) { | |||
1286 | 884 | if ( $cons->{$con_name}->[0]->{CONSTRAINT_TYPE} eq 'PRIMARY KEY' ) { | |||
1287 | 764 | return $cons->{$con_name}; | |||
1288 | } | ||||
1289 | } | ||||
1290 | |||||
1291 | 0 | return []; | |||
1292 | } | ||||
1293 | |||||
1294 - 1305 | =item get_pk_index($table) Returns an arrayref of the primary key index for a given table. Returns an empty arrayref if none were found. The structure of the returned data is: $aref->[ { col1 }, { col2 }, ... ] See "get_indexes" for a list of the hash elements in each column. =cut | ||||
1306 | |||||
1307 | sub get_pk_index { | ||||
1308 | 2 | my $self = shift; | |||
1309 | 2 | my $table = shift; | |||
1310 | |||||
1311 | # if ($table !~ /\./) { | ||||
1312 | # $table = $self->_schema . ".$table"; | ||||
1313 | # } | ||||
1314 | |||||
1315 | 2 | my $href = $self->get_indexes($table); | |||
1316 | |||||
1317 | 1 | foreach my $name ( keys(%$href) ) { | |||
1318 | 2 | if ( $name eq 'PRIMARY' ) # mysql forces this naming convention | |||
1319 | { | ||||
1320 | 1 | return $href->{$name}; | |||
1321 | } | ||||
1322 | } | ||||
1323 | |||||
1324 | 0 | return []; | |||
1325 | } | ||||
1326 | |||||
1327 - 1332 | =item get_pk_name($table) Returns the primary key constraint name for a given table. Returns undef if one does not exist. =cut | ||||
1333 | |||||
1334 | sub get_pk_name { | ||||
1335 | 116 | my $self = shift; | |||
1336 | 116 | my $table = shift || confess "missing table arg"; | |||
1337 | |||||
1338 | 116 | if ( $self->has_pk($table) ) { | |||
1339 | 116 | return 'PRIMARY'; # mysql default | |||
1340 | } | ||||
1341 | |||||
1342 | 0 | return; | |||
1343 | } | ||||
1344 | |||||
1345 - 1350 | =item get_tables( ) Returns an arrayref of tables in the current database. Returns undef if no tables were found. =cut | ||||
1351 | |||||
1352 | sub get_tables { | ||||
1353 | 9 | my $self = shift; | |||
1354 | |||||
1355 | 9 | my $dbh = $self->_dbh; | |||
1356 | |||||
1357 | 9 | my $tables = undef; | |||
1358 | 9 | my $sth = $dbh->prepare("show full tables where Table_Type = 'BASE TABLE'"); | |||
1359 | 9 | $sth->execute; | |||
1360 | |||||
1361 | 9 | while ( my ($table) = $sth->fetchrow_array ) { | |||
1362 | 81 | push( @$tables, $table ); | |||
1363 | } | ||||
1364 | |||||
1365 | 9 | return $tables; | |||
1366 | } | ||||
1367 | |||||
1368 - 1372 | =item has_ak($table) Returns true if the table has an alternate key or false if not. =cut | ||||
1373 | |||||
1374 | sub has_ak { | ||||
1375 | 223 | my $self = shift; | |||
1376 | 223 | my $table = shift || confess "missing table arg"; | |||
1377 | |||||
1378 | 222 | my $aks_href = $self->get_ak_constraints($table); | |||
1379 | |||||
1380 | 221 | return scalar keys %$aks_href; | |||
1381 | } | ||||
1382 | |||||
1383 - 1387 | =item has_fks($table) Returns true if the table has foreign keys or false if not. =cut | ||||
1388 | |||||
1389 | sub has_fks { | ||||
1390 | 5 | my $self = shift; | |||
1391 | 5 | my $table = shift || confess "missing table arg"; | |||
1392 | |||||
1393 | 4 | my $fks_href = $self->get_fk_constraints($table); | |||
1394 | |||||
1395 | 3 | return scalar keys %$fks_href; | |||
1396 | } | ||||
1397 | |||||
1398 - 1402 | =item has_pk($table) Returns true if the table has a primary key or false if it does not. =cut | ||||
1403 | |||||
1404 | sub has_pk { | ||||
1405 | 549 | my $self = shift; | |||
1406 | 549 | my $table = shift || confess "missing table arg"; | |||
1407 | |||||
1408 | 549 | my $pk_aref = $self->get_pk_constraint($table); | |||
1409 | |||||
1410 | 548 | return scalar @$pk_aref; | |||
1411 | } | ||||
1412 | |||||
1413 - 1418 | =item is_pk_auto_inc($table) Returns true if the primary key is using the auto-increment feature or false if it does not. =cut | ||||
1419 | |||||
1420 | sub is_pk_auto_inc { | ||||
1421 | 216 | my $self = shift; | |||
1422 | 216 | my $table = shift || confess "missing table arg"; | |||
1423 | |||||
1424 | 216 | if ( $self->has_pk($table) ) { | |||
1425 | 216 | my $pk_aref = $self->get_pk_constraint($table); | |||
1426 | |||||
1427 | 216 | foreach my $col_href (@$pk_aref) { | |||
1428 | |||||
1429 | 257 | my $col_name = $col_href->{COLUMN_NAME}; | |||
1430 | 257 | my $col_desc_href = $self->describe_column( | |||
1431 | table => $table, | ||||
1432 | column => $col_name | ||||
1433 | ); | ||||
1434 | |||||
1435 | 257 | if ( $col_desc_href->{EXTRA} =~ /auto/ ) { | |||
1436 | 100 | return 1; | |||
1437 | } | ||||
1438 | } | ||||
1439 | } | ||||
1440 | |||||
1441 | 116 | return 0; | |||
1442 | } | ||||
1443 | |||||
1444 - 1448 | =item is_column_nullable(table => $table, column => $column) Returns true if column is nullable or false if it is not. =cut | ||||
1449 | |||||
1450 | sub is_column_nullable { | ||||
1451 | 3 | args | |||
1452 | |||||
1453 | # required | ||||
1454 | my $self => 'Object', | ||||
1455 | my $table => 'Str', | ||||
1456 | my $column => 'Str'; | ||||
1457 | |||||
1458 | 2 | my $desc = $self->describe_column( table => $table, column => $column ); | |||
1459 | |||||
1460 | 2 | if ( $desc->{NULL} eq 'YES' ) { | |||
1461 | 1 | return 1; | |||
1462 | } | ||||
1463 | |||||
1464 | 1 | return 0; | |||
1465 | } | ||||
1466 | |||||
1467 - 1471 | =item is_fk_column(table => $table, column => $column) Returns true if column participates in a foreign key or false if it does not. =cut | ||||
1472 | |||||
1473 | sub is_fk_column { | ||||
1474 | 254 | my $self = shift; | |||
1475 | 254 | my %a = @_; | |||
1476 | |||||
1477 | 254 | my $table = $a{table} || confess "missing table arg"; | |||
1478 | 254 | my $column = $a{column} || confess "missing column arg"; | |||
1479 | |||||
1480 | 254 | my $fks_href = $self->get_fk_constraints($table); | |||
1481 | |||||
1482 | 254 | foreach my $fk_name ( keys %$fks_href ) { | |||
1483 | |||||
1484 | 374 374 | foreach my $fk_href ( @{ $fks_href->{$fk_name} } ) { | |||
1485 | |||||
1486 | 374 | if ( $fk_href->{COLUMN_NAME} eq $column ) { | |||
1487 | 248 | return 1; | |||
1488 | } | ||||
1489 | } | ||||
1490 | } | ||||
1491 | |||||
1492 | 6 | return 0; | |||
1493 | } | ||||
1494 | |||||
1495 - 1501 | =item is_self_referencing($table, [$name => $constraint_name]) Returns true if the specified table has a self-referencing foreign key or false if it does not. If a constraint name is passed, it will only check the constraint provided. =cut | ||||
1502 | |||||
1503 | sub is_self_referencing { | ||||
1504 | 554 | args | |||
1505 | |||||
1506 | # required | ||||
1507 | my $self => 'Object', | ||||
1508 | my $table => 'Str', | ||||
1509 | |||||
1510 | # optional | ||||
1511 | my $name => { isa => 'Str', optional => 1 }; | ||||
1512 | |||||
1513 | 554 | my $fq_table = $self->_fq( table => $table, fq => 1 ); | |||
1514 | |||||
1515 | 554 | my $fks_href = $self->get_fk_constraints($table); | |||
1516 | |||||
1517 | 554 | foreach my $con_name (%$fks_href) { | |||
1518 | 686 | next if $name and $name ne $con_name; | |||
1519 | |||||
1520 | #$hashref->{constraint_name}->[ { col1 }, { col2 } ] | ||||
1521 | # | ||||
1522 | #Hash elements for each column: | ||||
1523 | # | ||||
1524 | # CONSTRAINT_SCHEMA | ||||
1525 | # CONSTRAINT_TYPE | ||||
1526 | # COLUMN_NAME | ||||
1527 | # ORDINAL_POSITION | ||||
1528 | # POSITION_IN_UNIQUE_CONSTRAINT | ||||
1529 | # REFERENCED_COLUMN_NAME | ||||
1530 | # REFERENCED_TABLE_SCHEMA | ||||
1531 | # REFERENCED_TABLE_NAME | ||||
1532 | |||||
1533 | 4 4 | foreach my $pos_href ( @{ $fks_href->{$con_name} } ) { | |||
1534 | |||||
1535 | 2 | my $ref_table = $pos_href->{REFERENCED_TABLE_NAME}; | |||
1536 | 2 | my $ref_schema = $pos_href->{REFERENCED_TABLE_SCHEMA}; | |||
1537 | |||||
1538 | 2 | my $ref_fq_table = $self->_fq( | |||
1539 | table => $ref_table, | ||||
1540 | fq => 1, | ||||
1541 | schema => $ref_schema | ||||
1542 | ); | ||||
1543 | |||||
1544 | 2 | if ( $ref_fq_table eq $fq_table ) { | |||
1545 | 0 | return 1; | |||
1546 | } | ||||
1547 | } | ||||
1548 | } | ||||
1549 | |||||
1550 | 554 | return 0; | |||
1551 | } | ||||
1552 | |||||
1553 - 1557 | =item table_exists($table) Returns true if table exists. Otherwise returns false. =cut | ||||
1558 | |||||
1559 | sub table_exists { | ||||
1560 | 48 | my $self = shift; | |||
1561 | 48 | my $table = shift or confess "missing table arg"; | |||
1562 | |||||
1563 | 47 | my $fq_table = $table; | |||
1564 | 47 | if ( $table !~ /\./ ) { | |||
1565 | 2 | $fq_table = $self->_schema . ".$table"; | |||
1566 | } | ||||
1567 | |||||
1568 | 47 | my $dbh = $self->_dbh; | |||
1569 | |||||
1570 | 47 | my ( $schema, $nofq_table ) = split( /\./, $fq_table ); | |||
1571 | 47 | if ( $schema ne $self->_schema ) { | |||
1572 | |||||
1573 | # quietly change the schema so "show tables like ..." works | ||||
1574 | 2 | $dbh->do("use $schema"); | |||
1575 | } | ||||
1576 | |||||
1577 | 47 | my $sql = qq{show tables like '$nofq_table'}; | |||
1578 | 47 | my $sth = $dbh->prepare($sql); | |||
1579 | 47 | $sth->execute; | |||
1580 | |||||
1581 | 47 | my $cnt = 0; | |||
1582 | 47 | while ( $sth->fetchrow_array ) { | |||
1583 | 39 | $cnt++; | |||
1584 | } | ||||
1585 | |||||
1586 | 47 | if ( $schema ne $self->_schema ) { | |||
1587 | |||||
1588 | # quietly change schema back | ||||
1589 | 2 | $dbh->do( "use " . $self->_schema ); | |||
1590 | } | ||||
1591 | |||||
1592 | 47 | return $cnt; | |||
1593 | } | ||||
1594 | |||||
1595 - 1599 | =item use_db($dbname) Used for switching database context. Returns true on success. =cut | ||||
1600 | |||||
1601 | sub use_db { | ||||
1602 | 4 | my $self = shift; | |||
1603 | 4 | my $dbname = shift; | |||
1604 | |||||
1605 | 4 | $self->_dbh->do("use $dbname"); | |||
1606 | 4 | $self->_schema($dbname); | |||
1607 | 4 | $self->clear_cache; | |||
1608 | |||||
1609 | 4 | return 1; | |||
1610 | } | ||||
1611 | |||||
1612 | =back | ||||
1613 | |||||
1614 - 1626 | =head1 ADDITIONAL METHODS =over =item clear_cache() Clears the object's internal cache. If you modify the database ddl without going through the object, then you need to clear the internal cache so any future object calls don't return stale information. =cut | ||||
1627 | |||||
1628 | sub clear_cache { | ||||
1629 | 5 | my $self = shift; | |||
1630 | |||||
1631 | 5 | $self->_index_cache( {} ); | |||
1632 | 5 | $self->_constraint_cache( {} ); | |||
1633 | 5 | $self->_depth_cache( {} ); | |||
1634 | 5 | $self->_describe_cache( {} ); | |||
1635 | } | ||||
1636 | |||||
1637 - 1644 | =item clone_dbh() Returns a cloned copy of the internal database handle per the DBI::clone method. Beware that the database context will be the same as the object's. For example, if you called "use_db" and switched context along the way, the returned dbh will also be in that same context. =cut | ||||
1645 | |||||
1646 | sub clone_dbh { | ||||
1647 | 5 | my $self = shift; | |||
1648 | |||||
1649 | 5 | my $dbh = | |||
1650 | $self->_dbh->clone( { AutoCommit => 0 } ); # workaround dbd:mysql bug | ||||
1651 | 5 | $dbh->{AutoCommit} = 1; # workaround dbd:mysql bug | |||
1652 | 5 | $dbh->do( "use " . $self->_schema ); | |||
1653 | |||||
1654 | 5 | return $dbh; | |||
1655 | } | ||||
1656 | |||||
1657 | =back | ||||
1658 | |||||
1659 - 1703 | =head1 SEE ALSO MySQL::Util::Data::Create =head1 AUTHOR John Gravatt, C<< <gravattj at cpan.org> >> =head1 BUGS Please report any bugs or feature requests to C<bug-mysql-util at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MySQL-Util>. 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 You can also look for information at: =over 4 =item * RT: CPAN's request tracker L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MySQL-Util> =item * AnnoCPAN: Annotated CPAN documentation L<http://annocpan.org/dist/MySQL-Util> =item * CPAN Ratings L<http://cpanratings.perl.org/d/MySQL-Util> =item * Search CPAN L<http://search.cpan.org/dist/MySQL-Util/> =back =cut | ||||
1704 | |||||
1705 | #=head1 ACKNOWLEDGEMENTS | ||||
1706 | |||||
1707 - 1718 | =head1 LICENSE AND COPYRIGHT Copyright 2011 John Gravatt. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut | ||||
1719 | |||||
1720 | __PACKAGE__->meta->make_immutable; # moose stuff | ||||
1721 | |||||
1722 | 1; |