# This program is copyright 2007-2011 Baron Schwartz, 2011 Percona Inc. # Feedback and improvements are welcome. # # THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. # # This program is free software; you can redistribute it and/or modify it under # the terms of the GNU General Public License as published by the Free Software # Foundation, version 2; OR the Perl Artistic License. On UNIX and similar # systems, you can issue `man perlgpl' or `man perlartistic' to read these # licenses. # # You should have received a copy of the GNU General Public License along with # this program; if not, write to the Free Software Foundation, Inc., 59 Temple # Place, Suite 330, Boston, MA 02111-1307 USA. # ########################################################################### # MySQLDump package # ########################################################################### { # Package: MySQLDump # MySQLDump gets CREATE TABLE defs from MySQL. package MySQLDump; use strict; use warnings FATAL => 'all'; use English qw(-no_match_vars); use constant MKDEBUG => $ENV{MKDEBUG} || 0; ( our $before = <<'EOF') =~ s/^ //gm; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */; /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */; /*!40101 SET NAMES utf8 */; /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */; /*!40103 SET TIME_ZONE='+00:00' */; /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */; /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */; /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */; /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */; EOF ( our $after = <<'EOF') =~ s/^ //gm; /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */; /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */; /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */; /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */; /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */; EOF sub new { my ( $class, %args ) = @_; my $self = { cache => 0, # Afaik no script uses this cache any longer because # it has caused difficult-to-find bugs in the past. }; return bless $self, $class; } sub dump { my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_; if ( $what eq 'table' ) { my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); return unless $ddl; if ( $ddl->[0] eq 'table' ) { return $before . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" . $ddl->[1] . ";\n"; } else { return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n/*!50001 " . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n"; } } elsif ( $what eq 'triggers' ) { my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl); if ( $trgs && @$trgs ) { my $result = $before . "\nDELIMITER ;;\n"; foreach my $trg ( @$trgs ) { if ( $trg->{sql_mode} ) { $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n}; } $result .= "/*!50003 CREATE */ "; if ( $trg->{definer} ) { my ( $user, $host ) = map { s/'/''/g; "'$_'"; } split('@', $trg->{definer}, 2); $result .= "/*!50017 DEFINER=$user\@$host */ "; } $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n", $quoter->quote($trg->{trigger}), @{$trg}{qw(timing event)}, $quoter->quote($trg->{table}), $trg->{statement}); } $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n"; return $result; } else { return undef; } } elsif ( $what eq 'view' ) { my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" . '/*!50001 ' . $ddl->[1] . "*/;\n"; } else { die "You didn't say what to dump."; } } # USEs the given database. sub _use_db { my ( $self, $dbh, $quoter, $new ) = @_; if ( !$new ) { MKDEBUG && _d('No new DB to use'); return; } my $sql = 'USE ' . $quoter->quote($new); MKDEBUG && _d($dbh, $sql); $dbh->do($sql); return; } sub get_create_table { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) { my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; MKDEBUG && _d($sql); eval { $dbh->do($sql); }; MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $self->_use_db($dbh, $quoter, $db); $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); MKDEBUG && _d($sql); my $href; eval { $href = $dbh->selectrow_hashref($sql); }; if ( $EVAL_ERROR ) { warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR"; return; } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; MKDEBUG && _d($sql); $dbh->do($sql); my ($key) = grep { m/create table/i } keys %$href; if ( $key ) { MKDEBUG && _d('This table is a base table'); $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; } else { MKDEBUG && _d('This table is a view'); ($key) = grep { m/create view/i } keys %$href; $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; } } return $self->{tables}->{$db}->{$tbl}; } sub get_columns { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; MKDEBUG && _d('Get columns for', $db, $tbl); if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { $self->_use_db($dbh, $quoter, $db); my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); MKDEBUG && _d($sql); my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); $self->{columns}->{$db}->{$tbl} = [ map { my %row; @row{ map { lc $_ } keys %$_ } = values %$_; \%row; } @$cols ]; } return $self->{columns}->{$db}->{$tbl}; } sub get_tmp_table { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n"; $result .= join(",\n", map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } @{$self->get_columns($dbh, $quoter, $db, $tbl)}); $result .= "\n)"; MKDEBUG && _d($result); return $result; } sub get_triggers { my ( $self, $dbh, $quoter, $db, $tbl ) = @_; if ( !$self->{cache} || !$self->{triggers}->{$db} ) { $self->{triggers}->{$db} = {}; my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; MKDEBUG && _d($sql); eval { $dbh->do($sql); }; MKDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); MKDEBUG && _d($sql); my $sth = $dbh->prepare($sql); $sth->execute(); if ( $sth->rows ) { my $trgs = $sth->fetchall_arrayref({}); foreach my $trg (@$trgs) { # Lowercase the hash keys because the NAME_lc property might be set # on the $dbh, so the lettercase is unpredictable. This makes them # predictable. my %trg; @trg{ map { lc $_ } keys %$trg } = values %$trg; push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg; } } $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; MKDEBUG && _d($sql); $dbh->do($sql); } if ( $tbl ) { return $self->{triggers}->{$db}->{$tbl}; } return values %{$self->{triggers}->{$db}}; } sub get_databases { my ( $self, $dbh, $quoter, $like ) = @_; if ( !$self->{cache} || !$self->{databases} || $like ) { my $sql = 'SHOW DATABASES'; my @params; if ( $like ) { $sql .= ' LIKE ?'; push @params, $like; } my $sth = $dbh->prepare($sql); MKDEBUG && _d($sql, @params); $sth->execute( @params ); my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; $self->{databases} = \@dbs unless $like; return @dbs; } return @{$self->{databases}}; } sub get_table_status { my ( $self, $dbh, $quoter, $db, $like ) = @_; if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) { my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db); my @params; if ( $like ) { $sql .= ' LIKE ?'; push @params, $like; } MKDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref({})}; @tables = map { my %tbl; # Make a copy with lowercased keys @tbl{ map { lc $_ } keys %$_ } = values %$_; $tbl{engine} ||= $tbl{type} || $tbl{comment}; delete $tbl{type}; \%tbl; } @tables; $self->{table_status}->{$db} = \@tables unless $like; return @tables; } return @{$self->{table_status}->{$db}}; } sub get_table_list { my ( $self, $dbh, $quoter, $db, $like ) = @_; if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) { my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db); my @params; if ( $like ) { $sql .= ' LIKE ?'; push @params, $like; } MKDEBUG && _d($sql, @params); my $sth = $dbh->prepare($sql); $sth->execute(@params); my @tables = @{$sth->fetchall_arrayref()}; @tables = map { my %tbl = ( name => $_->[0], engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '', ); \%tbl; } @tables; $self->{table_list}->{$db} = \@tables unless $like; return @tables; } return @{$self->{table_list}->{$db}}; } sub _d { my ($package, undef, $line) = caller 0; @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } map { defined $_ ? $_ : 'undef' } @_; print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; } 1; } # ########################################################################### # End MySQLDump package # ###########################################################################