File Coverage

blib/lib/MySQL/Util.pm
Criterion Covered Total %
statement 24 495 4.8
branch 0 168 0.0
condition 0 42 0.0
subroutine 8 51 15.6
pod 33 35 94.2
total 65 791 8.2


line stmt bran cond sub pod time code
1             package MySQL::Util;
2 3     3   348978 use Moose;
  3         932052  
  3         21  
3 3     3   21097 use namespace::autoclean;
  3         16144  
  3         15  
4 3     3   4785 use DBI;
  3         53152  
  3         193  
5 3     3   34 use Carp;
  3         7  
  3         172  
6 3     3   1546 use DBIx::DataFactory;
  3         148086  
  3         33  
7 3     3   728 use Data::Dumper;
  3         6358  
  3         190  
8             $Data::Dumper::Sortkeys = 1;
9 3     3   1422 use MySQL::Util::Data::Cache;
  3         13  
  3         136  
10 3     3   25 use Smart::Args;
  3         8  
  3         20518  
11              
12             with 'MySQL::Util::Data::Create';
13              
14             =head1 NAME
15              
16             MySQL::Util - Utility functions for working with MySQL.
17              
18             =head1 VERSION
19              
20             Version 0.29
21              
22             =cut
23              
24             our $VERSION = '0.39';
25              
26             =head1 SYNOPSIS
27              
28             =for text
29             tmpdir/Testmysqlorm.pm
30             my $util = MySQL::Util->new( dsn => $ENV{DBI_DSN},
31             user => $ENV{DBI_USER} );
32              
33             my $util = MySQL::Util->new( dsn => $ENV{DBI_DSN},
34             user => $ENV{DBI_USER},
35             span => 1);
36              
37             my $util = MySQL::Util->new( dbh => $dbh );
38            
39             my $aref = $util->describe_table('mytable');
40             print "table: mytable\n";
41             foreach my $href (@$aref) {
42             print "\t", $href->{FIELD}, "\n";
43             }
44              
45             my $href = $util->get_ak_constraints('mytable');
46             my $href = $util->get_ak_indexes('mytable');
47             my $href = $util->get_constraints('mytable');
48              
49             #
50             # drop foreign keys example 1
51             #
52            
53             my $fks_aref = $util->drop_fks();
54              
55             < do some work here - perhaps truncate tables >
56              
57             $util->apply_ddl($fks_aref); # this will clear the cache for us. see
58             # clear_cache() for more info.
59              
60             #
61             # drop foreign keys example 2
62             #
63            
64             my $fks_aref = $util->drop_fks();
65              
66             my $dbh = $util->clone_dbh;
67             foreach my $stmt (@$fks_aref) {
68             $dbh->do($stmt);
69             }
70              
71             $util->clear_cache; # we modified the database ddl outside of the object so
72             # we need to clear the object's internal cache. see
73             # clear_cache() for more info.
74              
75             =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 0     0 0   my $self = shift;
168              
169 0 0         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 0           my $dbh = $self->dbh;
180              
181 0 0         if ( !$dbh ) {
182              
183 0           $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 0           $dbh->{AutoCommit} = 1; # dbd::mysql workarounda
196             }
197             else {
198 0           $dbh->{FetchHashKeyName} = 'NAME_uc';
199             }
200            
201 0           my $schema = $dbh->selectrow_arrayref("select schema()")->[0];
202 0 0         if ($schema) {
203 0           $self->_schema($schema);
204             }
205             else {
206 0           confess "unable to determine database name";
207             }
208            
209 0           $self->_set_dbh($dbh);
210             }
211              
212             #################################################################
213             #################### PRIVATE METHODS ############################
214             #################################################################
215              
216             #sub _get_ak_constraint_arrayref {
217             # args
218             # my $self => 'Object',
219             # my $table => 'Str',
220             # my $name => 'Str';
221             #
222             # my $href = $self->get_ak_constraints($table);
223             #
224             # if (defined $href->{$name}) {
225             # return $href->{$name};
226             # }
227             #
228             # confess "can't find ak constraint: $name";
229             #}
230              
231             sub _get_fk_column {
232 0     0     my $self = shift;
233 0           my %a = @_;
234              
235 0   0       my $table = $a{table} || confess "missing table arg";
236 0   0       my $column = $a{column} || confess "missing column arg";
237              
238 0           my $fks_href = $self->get_fk_constraints($table);
239              
240 0           foreach my $fk_name ( keys %$fks_href ) {
241              
242 0           foreach my $fk_href ( @{ $fks_href->{$fk_name} } ) {
  0            
243              
244 0 0         if ( $fk_href->{COLUMN_NAME} eq $column ) {
245 0           return $fk_href;
246             }
247             }
248             }
249              
250 0           confess "couldn't find where $table.$column is part of an fk?";
251             }
252              
253             sub _get_indexes_arrayref {
254 0     0     my $self = shift;
255 0           my $table = shift;
256              
257 0           my $cache = '_index_cache';
258              
259 0 0         if ( defined( $self->$cache->{$table} ) ) {
260 0           return $self->$cache->{$table}->data;
261             }
262              
263 0           my $dbh = $self->_dbh;
264 0           my $sth = $dbh->prepare("show indexes in $table");
265 0           $sth->execute;
266              
267 0           my $aref = [];
268 0           while ( my $href = $sth->fetchrow_hashref ) {
269 0           push( @$aref, {%$href} );
270             }
271              
272 0           $self->$cache->{$table} = MySQL::Util::Data::Cache->new( data => $aref );
273 0           return $aref;
274             }
275              
276             sub _fq {
277 0     0     args
278              
279             # required
280             my $self => 'Object',
281             my $table => 'Str',
282              
283             # optional
284             my $fq => { isa => 'Int', optional => 1, default => 1 },
285             my $schema => { isa => 'Str|Undef', optional => 1 };
286              
287 0 0         if ($fq) {
288 0 0         if ( $table =~ /\w\.\w/ ) {
    0          
289 0           return $table;
290             }
291             elsif ($schema) {
292 0           return "$schema.$table";
293             }
294              
295 0           return $self->_schema . ".$table";
296             }
297              
298 0 0         if ( $table =~ /^(\w+)\.(\w+)$/ ) {
299 0           my $curr = $self->_schema;
300              
301 0 0         confess "can't remove schema name from table name $table because we "
302             . "are not in the same db context (incoming fq table = $table, "
303             . "current schema = $curr"
304             if $curr ne $1;
305              
306 0           return $2;
307             }
308              
309 0           return $table;
310             }
311              
312             sub _un_fq {
313 0     0     args_pos
314              
315             # required
316             my $self => 'Object',
317             my $table => 'Str';
318              
319 0 0         if ( $table =~ /^(\w+)\.(\w+)$/ ) {
320 0           return ( $1, $2 );
321             }
322              
323 0           return ( $self->_schema, $table );
324             }
325              
326             sub _get_fk_ddl {
327 0     0     my $self = shift;
328 0           my $table = shift;
329 0           my $fk = shift;
330              
331 0           my $sql = "show create table $table";
332 0           my $sth = $self->_dbh->prepare($sql);
333 0           $sth->execute;
334              
335 0           while ( my @a = $sth->fetchrow_array ) {
336              
337 0           foreach my $data (@a) {
338 0           my @b = split( /\n/, $data );
339              
340 0           foreach my $item (@b) {
341 0 0         if ( $item =~ /CONSTRAINT `$fk` FOREIGN KEY/ ) {
342 0           $item =~ s/^\s*//; # remove leading ws
343 0           $item =~ s/\s*//; # remove trailing ws
344 0           $item =~ s/,$//; # remove trailing comma
345              
346 0           return "alter table $table add $item";
347             }
348             }
349             }
350             }
351             }
352              
353             sub _column_exists {
354 0     0     my $self = shift;
355 0           my %a = @_;
356              
357 0 0         my $table = $a{table} or confess "missing table arg";
358 0 0         my $column = $a{column} or confess "missing column arg";
359              
360 0           my $desc_aref = $self->describe_table($table);
361              
362 0           foreach my $col_href (@$desc_aref) {
363              
364 0 0         if ( $col_href->{FIELD} eq $column ) {
365 0           return 1;
366             }
367             }
368              
369 0           return 0;
370             }
371              
372             sub _verbose {
373 0     0     args_pos
374              
375             # required
376             my $self => 'Object',
377             my $msg => 'Str',
378              
379             # optional
380             my $func_counter => { isa => 'Str', default => 0, optional => 1 };
381              
382 0           my $caller_func = ( caller(1) )[3];
383 0           my $caller_line = ( caller(0) )[2];
384              
385 0           my @caller_func = split( /\::/, $caller_func );
386 0           my $key = pop @caller_func;
387              
388 0 0         if ( $self->_verbose_funcs->{$key} ) {
389 0           print STDERR "[VERBOSE] $caller_func ($caller_line) ";
390 0 0         print STDERR "[cnt=$func_counter]" if $func_counter;
391 0           print STDERR "\n";
392              
393 0           chomp $msg;
394 0           foreach my $nl ( split /\n/, $msg ) {
395 0           print STDERR "\t$nl\n";
396             }
397             }
398             }
399              
400             sub _verbose_sql {
401 0     0     args_pos
402              
403             # required
404             my $self => 'Object',
405             my $sql => 'Str',
406              
407             # optional
408             my $func_counter => { isa => 'Int', default => 0, optional => 1 };
409              
410 0           my $caller_func = ( caller(1) )[3];
411 0           my $caller_line = ( caller(0) )[2];
412              
413 0           my @caller_func = split( /\::/, $caller_func );
414 0           my $key = pop @caller_func;
415              
416 0 0         if ( $self->_verbose_funcs->{$key} ) {
417 0           print STDERR "[VERBOSE] $caller_func ($caller_line) ";
418 0 0         print STDERR "[cnt=$func_counter]" if $func_counter;
419 0           print STDERR "\n";
420              
421 0           $sql = SQL::Beautify->new( query => $sql )->beautify;
422 0           foreach my $l ( split /\n/, $sql ) {
423 0           print STDERR "\t$l\n";
424             }
425             }
426             }
427              
428             #################################################################
429             ##################### PUBLIC METHODS ############################
430             #################################################################
431              
432             =head1 METHODS
433              
434             All methods croak in the event of failure unless otherwise noted.
435              
436             =over
437              
438             =item new( dsn => $dsn,
439             user => $user,
440             [pass => $pass],
441             [span => $span]);
442              
443             constructor
444             * dsn - standard DBI stuff
445             * user - db username
446             * pass - db password
447             * span - follow references that span databases (default 0)
448              
449             =cut
450              
451             =item apply_ddl( [ ... ])
452              
453             Runs arbitrary ddl commands passed in via an array ref.
454              
455             The advantage of this is it allows you to make ddl changes to the db without
456             having to worry about the object's internal cache (see clear_cache()).
457              
458             =cut
459              
460             sub apply_ddl {
461 0     0 1   args_pos
462              
463             # required
464             my $self => 'Object',
465             my $stmts_aref => 'ArrayRef';
466              
467 0           foreach my $stmt (@$stmts_aref) {
468 0           $self->_dbh->do($stmt);
469             }
470              
471 0           $self->clear_cache;
472             }
473              
474             =item describe_column(table => $table, column => $column)
475              
476             Returns a hashref for the requested column.
477              
478             Hash elements for each column:
479              
480             DEFAULT
481             EXTRA
482             FIELD
483             KEY
484             NULL
485             TYPE
486            
487             See MySQL documentation for more info on "describe <table>".
488            
489             =cut
490              
491             sub describe_column {
492 0     0 1   args
493              
494             # required
495             my $self => 'Object',
496             my $table => 'Str',
497             my $column => 'Str';
498              
499 0 0         if ( !$self->_column_exists( table => $table, column => $column ) ) {
500 0           confess "column $column does not exist in table $table";
501             }
502              
503 0           my $col_aref = $self->describe_table($table);
504              
505 0           foreach my $col_href (@$col_aref) {
506 0 0         if ( $col_href->{FIELD} =~ /^$column$/i ) {
507 0           return $col_href;
508             }
509             }
510             }
511              
512             =item describe_table($table)
513              
514             Returns an arrayref of column info for a given table.
515              
516             The structure of the returned data is:
517              
518             $arrayref->[ { col1 }, { col2 } ]
519              
520             Hash elements for each column:
521              
522             DEFAULT
523             EXTRA
524             FIELD
525             KEY
526             NULL
527             TYPE
528            
529             See MySQL documentation for more info on "describe <table>".
530            
531             =cut
532              
533             sub describe_table {
534 0     0 1   my $self = shift;
535 0           my $table = shift;
536              
537 0           $table = $self->_fq( table => $table, fq => 1 );
538              
539 0           my $cache = '_describe_cache';
540              
541 0 0         if ( defined( $self->$cache->{$table} ) ) {
542 0           return $self->$cache->{$table}->data;
543             }
544              
545 0           my $sql = qq{
546             describe $table
547             };
548              
549 0           my $dbh = $self->_dbh;
550 0           my $sth = $dbh->prepare($sql);
551 0           $sth->execute;
552              
553 0           my @cols;
554 0           while ( my $row = $sth->fetchrow_hashref ) {
555 0           push( @cols, {%$row} );
556             }
557              
558 0           $self->$cache->{$table} = MySQL::Util::Data::Cache->new( data => \@cols );
559 0           return \@cols;
560             }
561              
562             =item drop_fks([$table])
563              
564             Drops foreign keys for a given table or the entire database if no table is
565             provided.
566              
567             Returns an array ref of alter table statements to rebuild the dropped foreign
568             keys on success. Returns an empty array ref if no foreign keys were found.
569              
570             =cut
571              
572             sub drop_fks {
573 0     0 1   my $self = shift;
574 0           my $table = shift;
575              
576 0           my @tables;
577 0 0         if ( !defined($table) ) {
578 0           my $tables_aref = $self->get_tables;
579 0 0         return [] if !defined($tables_aref);
580              
581 0           @tables = @$tables_aref;
582             }
583             else {
584 0           push( @tables, $table );
585             }
586              
587 0           my @ret;
588 0           foreach my $table (@tables) {
589              
590 0           my $fqtn = $self->_schema . ".$table";
591 0           my $fks_href = $self->get_fk_constraints($table);
592              
593 0           foreach my $fk ( keys %$fks_href ) {
594              
595 0           push( @ret, $self->_get_fk_ddl( $table, $fk ) );
596              
597 0           my $sql = qq{
598             alter table $table
599             drop foreign key $fk
600             };
601 0           $self->_dbh->do($sql);
602              
603 0           $self->_constraint_cache->{$fqtn} = undef;
604             }
605             }
606              
607 0           return [@ret];
608             }
609              
610             =item get_ak_constraints($table)
611              
612             Returns a hashref of the alternate key constraints for a given table. Returns
613             an empty hashref if none were found. The primary key is excluded from the
614             returned data.
615              
616             The structure of the returned data is:
617              
618             $hashref->{constraint_name}->[ { col1 }, { col2 } ]
619              
620             See "get_constraints" for a list of the hash elements in each column.
621              
622             =cut
623              
624             sub get_ak_constraints {
625 0     0 1   my $self = shift;
626 0 0         my $table = shift or confess "missing table arg";
627              
628 0           $table = $self->_fq( table => $table, fq => 1 );
629              
630 0           my $cons = $self->get_constraints($table);
631              
632 0           my $ret;
633 0           foreach my $con_name ( keys(%$cons) ) {
634 0 0         if ( $cons->{$con_name}->[0]->{CONSTRAINT_TYPE} eq 'UNIQUE' ) {
635 0           $ret->{$con_name} = $cons->{$con_name};
636             }
637             }
638              
639 0           return $ret;
640             }
641              
642             =item get_ak_indexes($table)
643              
644             Returns a hashref of the alternate key indexes for a given table. Returns
645             an empty hashref if one was not found.
646              
647             The structure of the returned data is:
648              
649             $href->{index_name}->[ { col1 }, { col2 } ]
650              
651             See get_indexes for a list of hash elements in each column.
652            
653             =cut
654              
655             sub get_ak_indexs {
656              
657             # for backwards compatibility
658 0     0 0   my $self = shift;
659 0           return $self->get_ak_indexes(@_);
660             }
661              
662             sub get_ak_indexes {
663 0     0 1   args_pos my $self => 'Object',
664             my $table => 'Str';
665              
666 0 0         if ( $table !~ /\./ ) {
667 0           $table = $self->_schema . ".$table";
668             }
669              
670 0           my $href = {};
671 0           my $indexes = $self->get_indexes($table);
672              
673 0           foreach my $index ( keys(%$indexes) ) {
674 0 0         if ( $indexes->{$index}->[0]->{NON_UNIQUE} == 0 ) {
675 0           $href->{$index} = $indexes->{$index};
676             }
677             }
678              
679 0           return $href;
680             }
681              
682             =item get_ak_names($table)
683              
684             Returns an arrayref of alternate key constraints. Returns undef if none
685             were found.
686              
687             =cut
688              
689             sub get_ak_names {
690 0     0 1   my $self = shift;
691 0   0       my $table = shift || confess "missing table arg";
692              
693 0 0         if ( $self->has_ak($table) ) {
694 0           my $href = $self->get_ak_constraints($table);
695 0           return ( keys %$href );
696             }
697              
698 0           return;
699             }
700              
701             =item get_constraint(table => $table, name => $constraint_name)
702              
703             Returns an arrayref for the requested constraints on a given table. Throws
704             an error if the constraint is not found.
705              
706             The structure of the returned data is:
707              
708             $arrayref->[ { col1 }, { col2 } ]
709              
710             Hash elements for each column:
711              
712             see get_constraints()
713              
714             =cut
715              
716             sub get_constraint {
717 0     0 1   args
718              
719             # required
720             my $self => 'Object',
721             my $name => 'Str',
722              
723             # optional
724             my $schema => { isa => 'Str', optional => 1 },
725             my $table => { isa => 'Str', optional => 1 };
726              
727 0           my ( $unfq_schema, $unfq_table, $fq_table );
728              
729 0 0         if ( defined $table ) {
730 0           ( $unfq_schema, $unfq_table ) = $self->_un_fq($table);
731 0 0         if ($schema) {
732 0 0         if ( $unfq_schema ne $schema ) {
733 0           confess "schema arg $schema does not match table $table";
734             }
735             }
736              
737 0           $fq_table = $self->_fq(
738             table => $unfq_table,
739             fq => 1,
740             schema => $unfq_schema
741             );
742             }
743              
744 0 0         if ( defined $fq_table ) {
745 0           my $cons_href = $self->get_constraints($fq_table);
746              
747 0           foreach my $cons_name ( keys %$cons_href ) {
748 0 0         if ( $cons_name eq $name ) {
749 0           return $cons_href->{$cons_name};
750             }
751             }
752              
753 0           confess "failed to find constraint $name for table $fq_table";
754             }
755              
756 0 0         $schema = $self->_schema if !$schema;
757              
758             #
759             # search cache for the constraint name across tables
760             #
761 0           my $cache = '_constraint_cache';
762              
763 0           foreach my $t ( keys %{ $self->$cache } ) {
  0            
764              
765 0 0         if ( defined( $self->$cache->{$t} ) ) {
766 0           my $data_href = $self->$cache->{$t}->data;
767              
768 0           foreach my $cons_name ( keys %$data_href ) {
769 0 0         if ( $cons_name eq $name ) {
770              
771 0           return $data_href->{$cons_name};
772             }
773             }
774             }
775             }
776              
777 0           my $sql = qq{
778             select distinct tc.table_name
779             from information_schema.table_constraints tc
780             where tc.constraint_schema = '$schema'
781             };
782              
783 0 0         if ( !$self->span ) {
784 0           $sql .= qq{
785             and (referenced_table_schema = '$schema' or referenced_table_schema is null)
786             };
787             }
788              
789 0           my $dbh = $self->_dbh;
790 0           my $sth = $dbh->prepare($sql);
791 0           $sth->execute;
792              
793 0           while ( my ($t) = $sth->fetchrow_array ) {
794 0           my $cons_href = $self->get_constraints( table => $t );
795              
796 0           foreach my $cons_name ( keys %$cons_href ) {
797 0 0         if ( $cons_name eq $name ) {
798 0           $sth->finish;
799 0           return $cons_href->{$cons_name};
800             }
801             }
802             }
803              
804 0           confess "failed to find constraint name $name";
805             }
806              
807             =item get_constraints($table)
808              
809             Returns a hashref of the constraints for a given table. Returns
810             an empty hashref if none were found.
811              
812             The structure of the returned data is:
813              
814             $hashref->{constraint_name}->[ { col1 }, { col2 } ]
815              
816             Hash elements for each column:
817              
818             CONSTRAINT_NAME
819             TABLE_NAME
820             CONSTRAINT_SCHEMA
821             CONSTRAINT_TYPE
822             COLUMN_NAME
823             ORDINAL_POSITION
824             POSITION_IN_UNIQUE_CONSTRAINT
825             REFERENCED_COLUMN_NAME
826             REFERENCED_TABLE_SCHEMA
827             REFERENCED_TABLE_NAME
828            
829             =cut
830              
831             sub get_constraints {
832 0     0 1   my $self = shift;
833 0   0       my $table = shift || confess "missing table arg";
834              
835 0           $table = $self->_fq( table => $table, fq => 1 );
836              
837 0           my ( $schema, $table_no_schema ) = split( /\./, $table );
838              
839 0           my $cache = '_constraint_cache';
840              
841 0 0         if ( defined( $self->$cache->{$table} ) ) {
842 0           return $self->$cache->{$table}->data;
843             }
844              
845 0 0         confess "table '$table' does not exist: " if !$self->table_exists($table);
846              
847 0           my $sql = qq{
848             select kcu.constraint_name, tc.constraint_type, column_name,
849             ordinal_position, position_in_unique_constraint, referenced_table_schema,
850             referenced_table_name, referenced_column_name, tc.constraint_schema
851             from information_schema.table_constraints tc,
852             information_schema.key_column_usage kcu
853             where tc.table_name = '$table_no_schema'
854             and tc.table_name = kcu.table_name
855             and tc.constraint_name = kcu.constraint_name
856             and tc.constraint_schema = '$schema'
857             and kcu.constraint_schema = tc.constraint_schema
858             };
859              
860 0 0         if ( !$self->span ) {
861 0           $sql .= qq{
862             and (referenced_table_schema = '$schema' or referenced_table_schema is null)
863             };
864             }
865              
866 0           $sql .= qq{ order by constraint_name, ordinal_position };
867              
868 0           my $dbh = $self->_dbh;
869 0           my $sth = $dbh->prepare($sql);
870 0           $sth->execute;
871              
872 0           my $href = {};
873 0           while ( my $row = $sth->fetchrow_hashref ) {
874              
875 0           my $name = $row->{CONSTRAINT_NAME};
876 0 0         if ( !defined( $href->{$name} ) ) { $href->{$name} = [] }
  0            
877              
878 0           $row->{TABLE_NAME} = $self->_fq( table => $table, fq => 0 );
879              
880 0           push( @{ $href->{$name} }, {%$row} );
  0            
881             }
882              
883 0           $self->$cache->{$table} = MySQL::Util::Data::Cache->new( data => $href );
884 0           return $href;
885             }
886              
887             =item get_dbname()
888              
889             Returns the name of the current schema/database.
890              
891             =cut
892              
893             sub get_dbname {
894 0     0 1   my $self = shift;
895 0 0         confess "get_dbname does not take any parameters" if @_;
896              
897 0           return $self->_schema;
898             }
899              
900             =item get_depth($table)
901              
902             Returns the table depth within the data model hierarchy. The depth is
903             zero based.
904              
905             For example:
906              
907             =for text
908              
909             ----------- -----------
910             | table A |------<| table B |
911             ----------- -----------
912              
913              
914             Table A has a depth of 0 and table B has a depth of 1. In other
915             words, table B is one level down in the model hierarchy.
916              
917             If a table has multiple parents, the parent with the highest depth wins.
918              
919             =cut
920              
921             sub get_depth {
922 0     0 1   my $self = shift;
923 0 0         my $table = shift or confess "missing table arg";
924              
925 0 0         if ( $table !~ /\./ ) {
926 0           $table = $self->_schema . ".$table";
927             }
928              
929 0           my $cache = '_depth_cache';
930              
931 0 0         if ( defined( $self->{$cache}->{$table} ) ) {
932 0           return $self->{$cache}->{$table};
933             }
934              
935 0           my $dbh = $self->_dbh;
936              
937 0           my $fk_cons = $self->get_fk_constraints($table);
938              
939 0           my $depth = 0;
940              
941 0           foreach my $fk_name ( keys(%$fk_cons) ) {
942             my $parent_table =
943             $fk_cons->{$fk_name}->[0]->{REFERENCED_TABLE_SCHEMA} . '.'
944 0           . $fk_cons->{$fk_name}->[0]->{REFERENCED_TABLE_NAME};
945              
946 0 0         if ( $parent_table eq $table ) { next } # self referencing table
  0            
947              
948 0           my $parent_depth = $self->get_depth($parent_table);
949 0 0         if ( $parent_depth >= $depth ) { $depth = $parent_depth + 1 }
  0            
950             }
951              
952 0           $self->{$cache}->{$table} = $depth;
953              
954 0           return $depth;
955             }
956              
957             =item get_fk_column_names(table => $table, [name => $constraint_name])
958              
959             If name is specified, returns an array of columns that participate in the
960             foreign key constraint. If name is not specified, returns an array of columns
961             that participate an any foreign key constraint on the table.
962              
963             =cut
964              
965             sub get_fk_column_names {
966 0     0 1   args
967              
968             # required
969             my $self => 'Object',
970             my $table => 'Str',
971              
972             # optional
973             my $name => { isa => 'Str', optional => 1 };
974              
975 0           $table = $self->_fq( table => $table, fq => 1 );
976              
977 0           my @columns;
978              
979 0           my $fks_href = $self->get_fk_constraints($table);
980              
981 0           foreach my $fk_name ( keys %$fks_href ) {
982              
983 0 0 0       next if ( $name and $name ne $fk_name );
984              
985 0           foreach my $fk_href ( @{ $fks_href->{$fk_name} } ) {
  0            
986              
987 0           my $col = $fk_href->{COLUMN_NAME};
988 0           push( @columns, $col );
989             }
990             }
991              
992 0           return @columns;
993             }
994              
995             =item get_fk_constraints([$table])
996              
997             Returns the foreign keys for a table or the entire database.
998              
999             Returns a hashref of the foreign key constraints on success. Returns
1000             an empty hashref if none were found.
1001              
1002             The structure of the returned data is:
1003              
1004             $hashref->{constraint_name}->[ { col1 }, { col2 } ]
1005              
1006             See "get_constraints" for a list of the hash elements in each column.
1007              
1008             =cut
1009              
1010             sub get_fk_constraints {
1011 0     0 1   args_pos
1012              
1013             # required
1014             my $self => 'Object',
1015              
1016             # optional
1017             my $table => { isa => 'Str', optional => 1 };
1018              
1019 0 0 0       if ( defined($table) and $table !~ /\./ ) {
1020 0           $table = $self->_schema . ".$table";
1021             }
1022              
1023 0           my @tables;
1024 0 0         if ( !defined($table) ) {
1025 0           my $tables_aref = $self->get_tables;
1026 0 0         return {} if !defined($tables_aref);
1027              
1028 0           @tables = @$tables_aref;
1029             }
1030             else {
1031 0           push( @tables, $table );
1032             }
1033              
1034 0           my $href = {};
1035              
1036 0           foreach my $table (@tables) {
1037              
1038 0           my $cons_href = $self->get_constraints($table);
1039 0           foreach my $cons_name ( keys(%$cons_href) ) {
1040              
1041 0           my $cons_aref = $cons_href->{$cons_name};
1042 0           foreach my $col_href (@$cons_aref) {
1043              
1044 0           my $type = $col_href->{CONSTRAINT_TYPE};
1045              
1046 0 0         if ( $type eq 'FOREIGN KEY' ) {
1047 0           $href->{$cons_name} = [@$cons_aref];
1048             }
1049             }
1050             }
1051             }
1052              
1053 0           return $href;
1054             }
1055              
1056             =item get_fk_indexes($table)
1057              
1058             Returns a hashref of the foreign key indexes for a given table. Returns
1059             an empty hashref if none were found. In order to qualify as a fk index,
1060             it must have a corresponding fk constraint.
1061              
1062             The structure of the returned data is:
1063              
1064             $hashref->{index_name}->[ { col1 }, { col2 } ]
1065              
1066             See "get_indexes" for a list of the hash elements in each column.
1067              
1068             =cut
1069              
1070             sub get_fk_indexes {
1071 0     0 1   args_pos my $self => 'Object',
1072             my $table => 'Str';
1073              
1074 0 0         if ( $table !~ /\./ ) {
1075 0           $table = $self->_schema . ".$table";
1076             }
1077              
1078 0           my $href = {};
1079 0           my $cons = $self->get_fk_constraints($table);
1080 0           my $indexes = $self->get_indexes($table);
1081              
1082 0           foreach my $con_name ( keys(%$cons) ) {
1083 0           my @con_cols = @{ $cons->{$con_name} };
  0            
1084              
1085 0           foreach my $index_name ( keys(%$indexes) ) {
1086 0           my @index_cols = @{ $indexes->{$index_name} };
  0            
1087              
1088 0 0         if ( scalar(@con_cols) == scalar(@index_cols) ) {
1089              
1090 0           my $match = 1;
1091 0           for ( my $i = 0 ; $i < scalar(@con_cols) ; $i++ ) {
1092 0 0         if ( $index_cols[$i]->{COLUMN_NAME} ne
1093             $con_cols[$i]->{COLUMN_NAME} )
1094             {
1095 0           $match = 0;
1096 0           last;
1097             }
1098             }
1099              
1100 0 0         if ($match) {
1101 0           $href->{$index_name} = $indexes->{$index_name};
1102 0           last;
1103             }
1104             }
1105             }
1106             }
1107              
1108 0           return $href;
1109             }
1110              
1111             =item get_indexes($table)
1112              
1113             Returns a hashref of the indexes for a given table. Returns
1114             an empty hashref if none were found.
1115              
1116             The structure of the returned data is:
1117              
1118             $href->{index_name}->[ { col1 }, { col2 } ]
1119              
1120             Hash elements for each column:
1121              
1122             CARDINALITY
1123             COLLATION
1124             COLUMN_NAME
1125             COMMENT
1126             INDEX_TYPE
1127             KEY_NAME
1128             NON_UNIQUE
1129             NULL
1130             PACKED
1131             SEQ_IN_INDEX
1132             SUB_PART
1133             TABLE
1134            
1135             =cut
1136              
1137             sub get_indexes {
1138 0     0 1   my $self = shift;
1139 0 0         my $table = shift or confess "missing table arg";
1140              
1141 0 0         if ( $table !~ /\./ ) {
1142 0           $table = $self->_schema . ".$table";
1143             }
1144              
1145 0           my %h = ();
1146 0           my $indexes = $self->_get_indexes_arrayref($table);
1147              
1148 0           foreach my $index (@$indexes) {
1149 0           my $key_name = $index->{KEY_NAME};
1150 0           my $seq = $index->{SEQ_IN_INDEX};
1151              
1152 0 0         if ( !exists( $h{$key_name} ) ) { $h{$key_name} = [] }
  0            
1153              
1154 0           $h{$key_name}->[ $seq - 1 ] = $index;
1155             }
1156              
1157 0           return \%h;
1158             }
1159              
1160             =item get_max_depth()
1161              
1162             Returns the max table depth for all tables in the database.
1163              
1164             See "get_depth" for additional info.
1165              
1166             =cut
1167              
1168             sub get_max_depth {
1169 0     0 1   my $self = shift;
1170              
1171 0           my $dbh = $self->_dbh;
1172              
1173 0           my $tables = $self->get_tables();
1174              
1175 0           my $max = 0;
1176 0           foreach my $table (@$tables) {
1177 0           my $depth = $self->get_depth($table);
1178 0 0         if ( $depth > $max ) { $max = $depth }
  0            
1179             }
1180              
1181 0           return $max;
1182             }
1183              
1184             =item get_other_constraints($table)
1185              
1186             Returns a hashref of the constraints that are not pk, ak, or fk
1187             for a given table. Returns an empty hashref if none were found.
1188              
1189             The structure of the returned data is:
1190              
1191             $hashref->{constraint_name}->[ { col1 }, { col2 } ]
1192              
1193             See "get_constraints" for a list of the hash elements in each column.
1194              
1195             =cut
1196              
1197             sub get_other_constraints {
1198 0     0 1   args_pos my $self => 'Object',
1199             my $table => 'Str';
1200              
1201 0 0         if ( $table !~ /\./ ) {
1202 0           $table = $self->_schema . ".$table";
1203             }
1204              
1205 0           my $fk = $self->get_fk_constraints($table);
1206 0           my $ak = $self->get_ak_constraints($table);
1207              
1208 0           my $href = {};
1209 0           my $cons = $self->get_constraints($table);
1210              
1211 0           foreach my $con_name ( keys(%$cons) ) {
1212 0           my $type = $cons->{$con_name}->[0]->{CONSTRAINT_TYPE};
1213              
1214 0 0         next if $type eq 'PRIMARY KEY';
1215 0 0         next if $type eq 'FOREIGN KEY';
1216 0 0         next if $type eq 'UNIQUE';
1217              
1218 0           $href->{$con_name} = $cons->{$con_name};
1219             }
1220              
1221 0           return $href;
1222             }
1223              
1224             =item get_other_indexes($table)
1225              
1226             Returns a hashref of the indexes that are not pk, ak, or fk
1227             for a given table. Returns an empty hashref if none were found.
1228              
1229             The structure of the returned data is:
1230              
1231             $hashref->{index_name}->[ { col1 }, { col2 } ]
1232              
1233             See "get_indexes" for a list of the hash elements in each column.
1234              
1235             =cut
1236              
1237             sub get_other_indexes {
1238 0     0 1   args_pos
1239              
1240             # required
1241             my $self => 'Object',
1242             my $table => 'Str';
1243              
1244 0 0         if ( $table !~ /\./ ) {
1245 0           $table = $self->_schema . ".$table";
1246             }
1247              
1248 0           my $ak = $self->get_ak_indexes($table);
1249 0           my $fk = $self->get_fk_indexes($table);
1250              
1251 0           my $href = {};
1252 0           my $indexes = $self->get_indexes($table);
1253              
1254 0           foreach my $name ( keys %$indexes ) {
1255 0 0         next if $name eq 'PRIMARY';
1256 0 0         next if defined( $ak->{$name} );
1257 0 0         next if defined( $fk->{$name} );
1258              
1259 0           $href->{$name} = $indexes->{$name};
1260             }
1261              
1262 0           return $href;
1263             }
1264              
1265             =item get_pk_constraint($table)
1266              
1267             Returns an arrayref of the primary key constraint for a given table. Returns
1268             an empty arrayref if none were found.
1269              
1270             The structure of the returned data is:
1271              
1272             $aref->[ { col1 }, { col2 }, ... ]
1273              
1274             See "get_constraints" for a list of hash elements in each column.
1275              
1276             =cut
1277              
1278             sub get_pk_constraint {
1279 0     0 1   my $self = shift;
1280 0           my $table = shift;
1281              
1282 0 0         if ( $table !~ /\./ ) {
1283 0           $table = $self->_schema . ".$table";
1284             }
1285              
1286 0           my $cons = $self->get_constraints($table);
1287              
1288 0           foreach my $con_name ( keys(%$cons) ) {
1289 0 0         if ( $cons->{$con_name}->[0]->{CONSTRAINT_TYPE} eq 'PRIMARY KEY' ) {
1290 0           return $cons->{$con_name};
1291             }
1292             }
1293              
1294 0           return [];
1295             }
1296              
1297             =item get_pk_index($table)
1298              
1299             Returns an arrayref of the primary key index for a given table. Returns
1300             an empty arrayref if none were found.
1301              
1302             The structure of the returned data is:
1303              
1304             $aref->[ { col1 }, { col2 }, ... ]
1305              
1306             See "get_indexes" for a list of the hash elements in each column.
1307              
1308             =cut
1309              
1310             sub get_pk_index {
1311 0     0 1   my $self = shift;
1312 0           my $table = shift;
1313              
1314             # if ($table !~ /\./) {
1315             # $table = $self->_schema . ".$table";
1316             # }
1317              
1318 0           my $href = $self->get_indexes($table);
1319              
1320 0           foreach my $name ( keys(%$href) ) {
1321 0 0         if ( $name eq 'PRIMARY' ) # mysql forces this naming convention
1322             {
1323 0           return $href->{$name};
1324             }
1325             }
1326              
1327 0           return [];
1328             }
1329              
1330             =item get_pk_name($table)
1331              
1332             Returns the primary key constraint name for a given table. Returns undef
1333             if one does not exist.
1334              
1335             =cut
1336              
1337             sub get_pk_name {
1338 0     0 1   my $self = shift;
1339 0   0       my $table = shift || confess "missing table arg";
1340              
1341 0 0         if ( $self->has_pk($table) ) {
1342 0           return 'PRIMARY'; # mysql default
1343             }
1344              
1345 0           return;
1346             }
1347              
1348             =item get_tables( )
1349              
1350             Returns an arrayref of tables in the current database. Returns undef
1351             if no tables were found.
1352              
1353             =cut
1354              
1355             sub get_tables {
1356 0     0 1   my $self = shift;
1357              
1358 0           my $dbh = $self->_dbh;
1359              
1360 0           my $tables = undef;
1361 0           my $sth = $dbh->prepare("show full tables where Table_Type = 'BASE TABLE'");
1362 0           $sth->execute;
1363              
1364 0           while ( my ($table) = $sth->fetchrow_array ) {
1365 0           push( @$tables, $table );
1366             }
1367              
1368 0           return $tables;
1369             }
1370              
1371             =item has_ak($table)
1372              
1373             Returns true if the table has an alternate key or false if not.
1374              
1375             =cut
1376              
1377             sub has_ak {
1378 0     0 1   my $self = shift;
1379 0   0       my $table = shift || confess "missing table arg";
1380              
1381 0           my $aks_href = $self->get_ak_constraints($table);
1382              
1383 0           return scalar keys %$aks_href;
1384             }
1385              
1386             =item has_fks($table)
1387            
1388             Returns true if the table has foreign keys or false if not.
1389            
1390             =cut
1391              
1392             sub has_fks {
1393 0     0 1   my $self = shift;
1394 0   0       my $table = shift || confess "missing table arg";
1395              
1396 0           my $fks_href = $self->get_fk_constraints($table);
1397              
1398 0           return scalar keys %$fks_href;
1399             }
1400              
1401             =item has_pk($table)
1402              
1403             Returns true if the table has a primary key or false if it does not.
1404              
1405             =cut
1406              
1407             sub has_pk {
1408 0     0 1   my $self = shift;
1409 0   0       my $table = shift || confess "missing table arg";
1410              
1411 0           my $pk_aref = $self->get_pk_constraint($table);
1412              
1413 0           return scalar @$pk_aref;
1414             }
1415              
1416             =item is_pk_auto_inc($table)
1417              
1418             Returns true if the primary key is using the auto-increment feature or false
1419             if it does not.
1420              
1421             =cut
1422              
1423             sub is_pk_auto_inc {
1424 0     0 1   my $self = shift;
1425 0   0       my $table = shift || confess "missing table arg";
1426              
1427 0 0         if ( $self->has_pk($table) ) {
1428 0           my $pk_aref = $self->get_pk_constraint($table);
1429              
1430 0           foreach my $col_href (@$pk_aref) {
1431              
1432 0           my $col_name = $col_href->{COLUMN_NAME};
1433 0           my $col_desc_href = $self->describe_column(
1434             table => $table,
1435             column => $col_name
1436             );
1437              
1438 0 0         if ( $col_desc_href->{EXTRA} =~ /auto/ ) {
1439 0           return 1;
1440             }
1441             }
1442             }
1443              
1444 0           return 0;
1445             }
1446              
1447             =item is_column_nullable(table => $table, column => $column)
1448              
1449             Returns true if column is nullable or false if it is not.
1450              
1451             =cut
1452              
1453             sub is_column_nullable {
1454 0     0 1   args
1455              
1456             # required
1457             my $self => 'Object',
1458             my $table => 'Str',
1459             my $column => 'Str';
1460              
1461 0           my $desc = $self->describe_column( table => $table, column => $column );
1462              
1463 0 0         if ( $desc->{NULL} eq 'YES' ) {
1464 0           return 1;
1465             }
1466              
1467 0           return 0;
1468             }
1469              
1470             =item is_fk_column(table => $table, column => $column)
1471              
1472             Returns true if column participates in a foreign key or false if it does not.
1473              
1474             =cut
1475              
1476             sub is_fk_column {
1477 0     0 1   my $self = shift;
1478 0           my %a = @_;
1479              
1480 0   0       my $table = $a{table} || confess "missing table arg";
1481 0   0       my $column = $a{column} || confess "missing column arg";
1482              
1483 0           my $fks_href = $self->get_fk_constraints($table);
1484              
1485 0           foreach my $fk_name ( keys %$fks_href ) {
1486              
1487 0           foreach my $fk_href ( @{ $fks_href->{$fk_name} } ) {
  0            
1488              
1489 0 0         if ( $fk_href->{COLUMN_NAME} eq $column ) {
1490 0           return 1;
1491             }
1492             }
1493             }
1494              
1495 0           return 0;
1496             }
1497              
1498             =item is_self_referencing($table, [$name => $constraint_name])
1499              
1500             Returns true if the specified table has a self-referencing foreign key or
1501             false if it does not. If a constraint name is passed, it will only check
1502             the constraint provided.
1503              
1504             =cut
1505              
1506             sub is_self_referencing {
1507 0     0 1   args
1508              
1509             # required
1510             my $self => 'Object',
1511             my $table => 'Str',
1512              
1513             # optional
1514             my $name => { isa => 'Str', optional => 1 };
1515              
1516 0           my $fq_table = $self->_fq( table => $table, fq => 1 );
1517              
1518 0           my $fks_href = $self->get_fk_constraints($table);
1519              
1520 0           foreach my $con_name (%$fks_href) {
1521 0 0 0       next if $name and $name ne $con_name;
1522              
1523             #$hashref->{constraint_name}->[ { col1 }, { col2 } ]
1524             #
1525             #Hash elements for each column:
1526             #
1527             # CONSTRAINT_SCHEMA
1528             # CONSTRAINT_TYPE
1529             # COLUMN_NAME
1530             # ORDINAL_POSITION
1531             # POSITION_IN_UNIQUE_CONSTRAINT
1532             # REFERENCED_COLUMN_NAME
1533             # REFERENCED_TABLE_SCHEMA
1534             # REFERENCED_TABLE_NAME
1535              
1536 0           foreach my $pos_href ( @{ $fks_href->{$con_name} } ) {
  0            
1537              
1538 0           my $ref_table = $pos_href->{REFERENCED_TABLE_NAME};
1539 0           my $ref_schema = $pos_href->{REFERENCED_TABLE_SCHEMA};
1540              
1541 0           my $ref_fq_table = $self->_fq(
1542             table => $ref_table,
1543             fq => 1,
1544             schema => $ref_schema
1545             );
1546              
1547 0 0         if ( $ref_fq_table eq $fq_table ) {
1548 0           return 1;
1549             }
1550             }
1551             }
1552              
1553 0           return 0;
1554             }
1555              
1556             =item table_exists($table)
1557              
1558             Returns true if table exists. Otherwise returns false.
1559              
1560             =cut
1561              
1562             sub table_exists {
1563 0     0 1   my $self = shift;
1564 0 0         my $table = shift or confess "missing table arg";
1565              
1566 0           my $fq_table = $table;
1567 0 0         if ( $table !~ /\./ ) {
1568 0           $fq_table = $self->_schema . ".$table";
1569             }
1570              
1571 0           my $dbh = $self->_dbh;
1572              
1573 0           my ( $schema, $nofq_table ) = split( /\./, $fq_table );
1574 0 0         if ( $schema ne $self->_schema ) {
1575              
1576             # quietly change the schema so "show tables like ..." works
1577 0           $dbh->do("use $schema");
1578             }
1579              
1580 0           my $sql = qq{show tables like '$nofq_table'};
1581 0           my $sth = $dbh->prepare($sql);
1582 0           $sth->execute;
1583              
1584 0           my $cnt = 0;
1585 0           while ( $sth->fetchrow_array ) {
1586 0           $cnt++;
1587             }
1588              
1589 0 0         if ( $schema ne $self->_schema ) {
1590              
1591             # quietly change schema back
1592 0           $dbh->do( "use " . $self->_schema );
1593             }
1594              
1595 0           return $cnt;
1596             }
1597              
1598             =item use_db($dbname)
1599              
1600             Used for switching database context. Returns true on success.
1601              
1602             =cut
1603              
1604             sub use_db {
1605 0     0 1   my $self = shift;
1606 0           my $dbname = shift;
1607              
1608 0           $self->_dbh->do("use $dbname");
1609 0           $self->_schema($dbname);
1610 0           $self->clear_cache;
1611              
1612 0           return 1;
1613             }
1614              
1615             =back
1616              
1617             =head1 ADDITIONAL METHODS
1618              
1619             =over
1620              
1621             =item clear_cache()
1622              
1623             Clears the object's internal cache.
1624              
1625             If you modify the database ddl without going through the object, then you need
1626             to clear the internal cache so any future object calls don't return stale
1627             information.
1628              
1629             =cut
1630              
1631             sub clear_cache {
1632 0     0 1   my $self = shift;
1633              
1634 0           $self->_index_cache( {} );
1635 0           $self->_constraint_cache( {} );
1636 0           $self->_depth_cache( {} );
1637 0           $self->_describe_cache( {} );
1638             }
1639              
1640             =item clone_dbh()
1641              
1642             Returns a cloned copy of the internal database handle per the DBI::clone
1643             method. Beware that the database context will be the same as the object's.
1644             For example, if you called "use_db" and switched context along the way, the
1645             returned dbh will also be in that same context.
1646              
1647             =cut
1648              
1649             sub clone_dbh {
1650 0     0 1   my $self = shift;
1651              
1652 0           my $dbh =
1653             $self->_dbh->clone( { AutoCommit => 0 } ); # workaround dbd:mysql bug
1654 0           $dbh->{AutoCommit} = 1; # workaround dbd:mysql bug
1655 0           $dbh->do( "use " . $self->_schema );
1656              
1657 0           return $dbh;
1658             }
1659              
1660             =back
1661              
1662             =head1 SEE ALSO
1663              
1664             MySQL::Util::Data::Create
1665              
1666             =head1 AUTHOR
1667              
1668             John Gravatt, C<< <gravattj at cpan.org> >>
1669              
1670             =head1 BUGS
1671              
1672             Please report any bugs or feature requests to C<bug-mysql-util at rt.cpan.org>, or through
1673             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=MySQL-Util>. I will be notified, and then you'll
1674             automatically be notified of progress on your bug as I make changes.
1675              
1676              
1677             =head1 SUPPORT
1678              
1679             You can find documentation for this module with the perldoc command.
1680              
1681             perldoc MySQL::Util
1682              
1683              
1684             You can also look for information at:
1685              
1686             =over 4
1687              
1688             =item * RT: CPAN's request tracker
1689              
1690             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=MySQL-Util>
1691              
1692             =item * AnnoCPAN: Annotated CPAN documentation
1693              
1694             L<http://annocpan.org/dist/MySQL-Util>
1695              
1696             =item * CPAN Ratings
1697              
1698             L<http://cpanratings.perl.org/d/MySQL-Util>
1699              
1700             =item * Search CPAN
1701              
1702             L<http://search.cpan.org/dist/MySQL-Util/>
1703              
1704             =back
1705              
1706             =cut
1707              
1708             #=head1 ACKNOWLEDGEMENTS
1709              
1710             =head1 LICENSE AND COPYRIGHT
1711              
1712             Copyright 2011 John Gravatt.
1713              
1714             This program is free software; you can redistribute it and/or modify it
1715             under the terms of either: the GNU General Public License as published
1716             by the Free Software Foundation; or the Artistic License.
1717              
1718             See http://dev.perl.org/licenses/ for more information.
1719              
1720              
1721             =cut
1722              
1723             __PACKAGE__->meta->make_immutable; # moose stuff
1724              
1725             1;