MySQL-Diff-0.60000755000000000000 013305551767 12365 5ustar00rootroot000000000000BUGS100644000000000000 122713305551767 13133 0ustar00rootroot000000000000MySQL-Diff-0.60Please see: https://rt.cpan.org/Public/Dist/Display.html?Name=MySQL-Diff which supercedes this file. Reported by users but unconfirmed: ================================== * If '-P1 3337' is one of the arguments it doesn't seem to get passed to the arguments for mysqldump (according to the debugging). [Darrell Taylor] Others ====== * You can't specify which database to connect to for creating temporary tables. * Things probably break if you use --password or -p without a parameter. * The remote authentication code is barely tested, and hence probably broken. All easy to fix but I'm so short on time! Patches welcome ... Changes100644000000000000 376013305551767 13747 0ustar00rootroot000000000000MySQL-Diff-0.60# Changes log for Test::CPAN::Meta Unreleased - added "--keep-old-columns" option that disables emitting DROP COLUMN commands 0.50 21 July 2016 - fix bug with 0.49's new feature (SilentScope) - added integration test (SilentScope) 0.49 15 July 2016 - added "--single-transaction" option for passing to mysqldump (SilentScope) 0.48 27 June 2016 - added support for AUTO_INCREMENT fields (mikeraynham) - fixed Build.PL conflict making smoker tests fail 0.46 21th June 2016 - Bug fixes - optimized the --table-re option to exclude tables before comparing them as this would cause significant slowdowns in databases with lots of tables. (bdraco) 0.43 6th October 2011 - fix missing fields in CPAN meta-data 0.43 6th October 2011 - depend on Perl 5.6 - improve docs and CPAN meta-data 0.41 5th October 2011 - tidy up POD 0.40 5th October 2011 - fix issue with hyphens in database names - made --tolerant ignore COLLATE and AUTO_INCREMENT - fixed 'Duplicate specification' options from Getopt::Long - made CLI options case-sensitive - fixed some coding style inconsistencies - remove .cvsignore - merged changes by Barbie - removed use of unmaintained Class::MakeMethods - repackaged distribution with additional package files - restructured modules to use namespace MySQL::Diff::* - restructured modules to use better OO style inferface - Utils.pm now only contains debug handling - added support for more recent MySQL dumps - added more documentation - added more tests - merged changes by Alexandr Ciornii - depend on Perl 5.5.3 - remove lib/MySQL/.cvsignore - fix .gitignore - upgrade Makefile.PL and Build.PL 0.33 8th May 2003 - see ChangeLog.OLD for previous changes. LICENSE100644000000000000 1455713305551767 13507 0ustar00rootroot000000000000MySQL-Diff-0.60 The Clarified Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Distribution fee" is a fee you charge for providing a copy of this Package to another party. "Freely Available" means that no fee is charged for the right to use the item, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain, or those made Freely Available, or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major network archive site allowing unrestricted access to them, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. e) permit and encourge anyone who receives a copy of the modified Package permission to make your modifications Freely Available in some specific way. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. e) offer the machine-readable source of the Package, with your modifications, by mail order. 5. You may charge a distribution fee for any distribution of this Package. If you offer support for this Package, you may charge any fee you choose for that support. You may not charge a license fee for the right to use this Package itself. You may distribute this Package in aggregate with other (possibly commercial and possibly nonfree) programs as part of a larger (possibly commercial and possibly nonfree) software distribution, and charge license fees for other parts of that software distribution, provided that you do not advertise this Package as a product of your own. If the Package includes an interpreter, You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of the Standard Version of the Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE 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. The End t000755000000000000 013305551767 12551 5ustar00rootroot000000000000MySQL-Diff-0.60all.t100644000000000000 3024013305551767 13665 0ustar00rootroot000000000000MySQL-Diff-0.60/t#!/usr/bin/perl -w use strict; use Test::More; use MySQL::Diff; use MySQL::Diff::Database; my $TEST_USER = 'test'; my @VALID_ENGINES = qw(MyISAM InnoDB); my $VALID_ENGINES = join '|', @VALID_ENGINES; my %tables = ( foo1 => ' CREATE TABLE foo ( id INT(11) NOT NULL auto_increment, foreign_id INT(11) NOT NULL, PRIMARY KEY (id) ) DEFAULT CHARACTER SET utf8; ', foo2 => ' # here be a comment CREATE TABLE foo ( id INT(11) NOT NULL auto_increment, foreign_id INT(11) NOT NULL, # another random comment field BLOB, PRIMARY KEY (id) ) DEFAULT CHARACTER SET utf8; ', foo3 => ' CREATE TABLE foo ( id INT(11) NOT NULL auto_increment, foreign_id INT(11) NOT NULL, field TINYBLOB, PRIMARY KEY (id) ) DEFAULT CHARACTER SET utf8; ', foo4 => ' CREATE TABLE foo ( id INT(11) NOT NULL auto_increment, foreign_id INT(11) NOT NULL, field TINYBLOB, PRIMARY KEY (id, foreign_id) ) DEFAULT CHARACTER SET utf8; ', bar1 => ' CREATE TABLE bar ( id INT AUTO_INCREMENT NOT NULL PRIMARY KEY, ctime DATETIME, utime DATETIME, name CHAR(16), age INT ) DEFAULT CHARACTER SET utf8; ', bar2 => ' CREATE TABLE bar ( id INT AUTO_INCREMENT NOT NULL PRIMARY KEY, ctime DATETIME, utime DATETIME, # FOO! name CHAR(16), age INT, UNIQUE (name, age) ) DEFAULT CHARACTER SET utf8; ', bar3 => ' CREATE TABLE bar ( id INT AUTO_INCREMENT NOT NULL PRIMARY KEY, ctime DATETIME, utime DATETIME, name CHAR(16), age INT, UNIQUE (id, name, age) ) DEFAULT CHARACTER SET utf8; ', baz1 => ' CREATE TABLE baz ( firstname CHAR(16), surname CHAR(16) ) DEFAULT CHARACTER SET utf8; ', baz2 => ' CREATE TABLE baz ( firstname CHAR(16), surname CHAR(16), UNIQUE (firstname, surname) ) DEFAULT CHARACTER SET utf8; ', baz3 => ' CREATE TABLE baz ( firstname CHAR(16), surname CHAR(16), KEY (firstname, surname) ) DEFAULT CHARACTER SET utf8; ', qux1 => ' CREATE TABLE qux ( age INT ) DEFAULT CHARACTER SET utf8; ', qux2 => ' CREATE TABLE qux ( id INT NOT NULL AUTO_INCREMENT, age INT, PRIMARY KEY (id) ) DEFAULT CHARACTER SET utf8; ', qux3 => ' CREATE TABLE qux ( id INT NOT NULL AUTO_INCREMENT, age INT, UNIQUE KEY (id) ) DEFAULT CHARACTER SET utf8; ', ); my %tests = ( 'add column' => [ {}, @tables{qw/foo1 foo2/}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo ADD COLUMN field blob; ', ], 'drop column' => [ {}, @tables{qw/foo2 foo1/}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo DROP COLUMN field; # was blob ', ], 'change column' => [ {}, @tables{qw/foo2 foo3/}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo CHANGE COLUMN field field tinyblob; # was blob ' ], 'no-old-defs' => [ { 'no-old-defs' => 1 }, @tables{qw/foo2 foo1/}, '## mysqldiff ## ## Run on ## Options: no-old-defs ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo DROP COLUMN field; ', ], 'add table' => [ { }, $tables{foo1}, $tables{foo2} . $tables{bar1}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo ADD COLUMN field blob; CREATE TABLE bar ( id int(11) NOT NULL auto_increment, ctime datetime default NULL, utime datetime default NULL, name char(16) default NULL, age int(11) default NULL, PRIMARY KEY (id) ) ENGINE=InnoDB DEFAULT CHARSET=utf8; ', ], 'drop table' => [ { }, $tables{foo1} . $tables{bar1}, $tables{foo2}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 DROP TABLE bar; ALTER TABLE foo ADD COLUMN field blob; ', ], 'only-both' => [ { 'only-both' => 1 }, $tables{foo1} . $tables{bar1}, $tables{foo2}, '## mysqldiff ## ## Run on ## Options: only-both ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo ADD COLUMN field blob; ', ], 'keep-old-tables' => [ { 'keep-old-tables' => 1 }, $tables{foo1} . $tables{bar1}, $tables{foo2}, '## mysqldiff ## ## Run on ## Options: keep-old-tables ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo ADD COLUMN field blob; ', ], 'keep-old-columns' => [ { 'keep-old-columns' => 1 }, $tables{foo2} . $tables{bar1}, $tables{foo1}, '## mysqldiff ## ## Run on ## Options: keep-old-columns ## ## --- file: tmp.db1 ## +++ file: tmp.db2 DROP TABLE bar; ', ], 'table-re' => [ { 'table-re' => 'ba' }, $tables{foo1} . $tables{bar1} . $tables{baz1}, $tables{foo2} . $tables{bar2} . $tables{baz2}, '## mysqldiff ## ## Run on ## Options: table-re=ba ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar ADD UNIQUE name (name,age); ALTER TABLE baz ADD UNIQUE firstname (firstname,surname); ', ], 'single-transaction' => [ { 'single-transaction' => 'ba' }, $tables{foo1} . $tables{bar1} . $tables{baz1}, $tables{foo2} . $tables{bar2} . $tables{baz2}, '## mysqldiff ## ## Run on ## Options: single-transaction=ba ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar ADD UNIQUE name (name,age); ALTER TABLE baz ADD UNIQUE firstname (firstname,surname); ALTER TABLE foo ADD COLUMN field blob; ', ], 'drop primary key with auto weirdness' => [ {}, $tables{foo3}, $tables{foo4}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo ADD INDEX (id); # auto columns must always be indexed ALTER TABLE foo DROP PRIMARY KEY; # was (id) ALTER TABLE foo ADD PRIMARY KEY (id,foreign_id); ALTER TABLE foo DROP INDEX id; ', ], 'drop additional primary key' => [ {}, $tables{foo4}, $tables{foo3}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE foo ADD INDEX (id); # auto columns must always be indexed ALTER TABLE foo DROP PRIMARY KEY; # was (id,foreign_id) ALTER TABLE foo ADD PRIMARY KEY (id); ALTER TABLE foo DROP INDEX id; ', ], 'unique changes' => [ {}, $tables{bar1}, $tables{bar2}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar ADD UNIQUE name (name,age); ', ], 'drop index' => [ {}, $tables{bar2}, $tables{bar1}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar DROP INDEX name; # was UNIQUE (name,age) ', ], 'alter indices' => [ {}, $tables{bar2}, $tables{bar3}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar DROP INDEX name; # was UNIQUE (name,age) ALTER TABLE bar ADD UNIQUE id (id,name,age); ', ], 'alter indices 2' => [ {}, $tables{bar3}, $tables{bar2}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar DROP INDEX id; # was UNIQUE (id,name,age) ALTER TABLE bar ADD UNIQUE name (name,age); ', ], 'add unique index' => [ {}, $tables{bar1}, $tables{bar3}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar ADD UNIQUE id (id,name,age); ', ], 'drop unique index' => [ {}, $tables{bar3}, $tables{bar1}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE bar DROP INDEX id; # was UNIQUE (id,name,age) ', ], 'alter unique index' => [ {}, $tables{baz2}, $tables{baz3}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE baz DROP INDEX firstname; # was UNIQUE (firstname,surname) ALTER TABLE baz ADD INDEX firstname (firstname,surname); ', ], 'alter unique index 2' => [ {}, $tables{baz3}, $tables{baz2}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE baz DROP INDEX firstname; # was INDEX (firstname,surname) ALTER TABLE baz ADD UNIQUE firstname (firstname,surname); ', ], 'add auto increment primary key' => [ {}, $tables{qux1}, $tables{qux2}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE qux ADD COLUMN id int(11) NOT NULL AUTO_INCREMENT PRIMARY KEY; ', ], 'add auto increment unique key' => [ {}, $tables{qux1}, $tables{qux3}, '## mysqldiff ## ## Run on ## ## --- file: tmp.db1 ## +++ file: tmp.db2 ALTER TABLE qux ADD COLUMN id int(11) NOT NULL AUTO_INCREMENT UNIQUE KEY; ', ], ); my $BAIL = check_setup(); plan skip_all => $BAIL if($BAIL); my $total = scalar(keys %tests) * 5; plan tests => $total; use Data::Dumper; my @tests = (keys %tests); #keys %tests { my %debug = ( debug_file => 'debug.log', debug => 9 ); unlink $debug{debug_file}; for my $test (@tests) { note( "Testing $test\n" ); my ($opts, $db1_defs, $db2_defs, $expected) = @{$tests{$test}}; note("test=".Dumper($tests{$test})); my $diff = MySQL::Diff->new(%$opts, %debug); isa_ok($diff,'MySQL::Diff'); my $db1 = get_db($db1_defs, 1, $opts->{'table-re'}, $opts->{'single_transaction'}); my $db2 = get_db($db2_defs, 2, $opts->{'table-re'}, $opts->{'single_transaction'}); my $d1 = $diff->register_db($db1, 1); my $d2 = $diff->register_db($db2, 2); note("d1=" . Dumper($d1)); note("d2=" . Dumper($d2)); isa_ok($d1, 'MySQL::Diff::Database'); isa_ok($d2, 'MySQL::Diff::Database'); my $diffs = $diff->diff(); $diffs =~ s/^## mysqldiff [\d.]+/## mysqldiff /m; $diffs =~ s/^## Run on .*/## Run on /m; $diffs =~ s{/\*!40\d{3} .*? \*/;\n*}{}m; $diffs =~ s/ *$//gm; for ($diffs, $expected) { s/ default\b/ DEFAULT/gi; s/PRIMARY KEY +\(/PRIMARY KEY (/g; s/auto_increment/AUTO_INCREMENT/gi; } my $engine = 'InnoDB'; my $ENGINE_RE = qr/ENGINE=($VALID_ENGINES)/; if ($diffs =~ $ENGINE_RE) { $engine = $1; $expected =~ s/$ENGINE_RE/ENGINE=$engine/g; } note("diffs = " . Dumper($diffs)); note("expected = " . Dumper($expected)); is_deeply($diffs, $expected, ".. expected differences for $test"); # Now test that $diffs correctly patches $db1_defs to $db2_defs. my $patched = get_db($db1_defs . "\n" . $diffs, 1, $opts->{'table-re'}, $opts->{'single-transaction'}); $diff->register_db($patched, 1); is_deeply($diff->diff(), '', ".. patched differences for $test"); } } sub get_db { my ($defs, $num, $table_re, $single_transaction) = @_; note("defs=$defs"); my $file = "tmp.db$num"; open(TMP, ">$file") or die "open: $!"; print TMP $defs; close(TMP); my $db = MySQL::Diff::Database->new(file => $file, auth => { user => $TEST_USER }, 'table-re' => $table_re, 'single-transaction' => $single_transaction); unlink $file; return $db; } sub check_setup { my $failure_string = "Cannot proceed with tests without "; _output_matches("mysql --help", qr/--password/) or return $failure_string . 'a MySQL client'; _output_matches("mysqldump --help", qr/--password/) or return $failure_string . 'mysqldump'; _output_matches("echo status | mysql -u $TEST_USER 2>&1", qr/Connection id:/) or return $failure_string . 'a valid connection'; return ''; } sub _output_matches { my ($cmd, $re) = @_; my ($exit, $out) = _run($cmd); my $issue; if (defined $exit) { if ($exit == 0) { $issue = "Output from '$cmd' didn't match /$re/:\n$out" if $out !~ $re; } else { $issue = "'$cmd' exited with status code $exit"; } } else { $issue = "Failed to execute '$cmd'"; } if ($issue) { warn $issue, "\n"; return 0; } return 1; } sub _run { my ($cmd) = @_; unless (open(CMD, "$cmd|")) { return (undef, "Failed to execute '$cmd': $!\n"); } my $out = join '', ; close(CMD); return ($?, $out); } dist.ini100644000000000000 67613305551767 14103 0ustar00rootroot000000000000MySQL-Diff-0.60name = MySQL-Diff version = 0.60 license = Perl_5 copyright_holder = Adam Spiers homepage = http://aspiers.github.io/mysqldiff/ [Bugtracker] web = https://github.com/aspiers/mysqldiff/issues mailto = [Repository] repository = https://github.com/aspiers/mysqldiff type = git ;; install bin/mysqldiff [ExecDir] [AutoPrereqs] [PruneCruft] [GatherDir] [MetaYAML] [MetaJSON] [MakeMaker] [Manifest] [TestRelease] [ConfirmRelease] [UploadToCPAN] META.yml100644000000000000 147513305551767 13726 0ustar00rootroot000000000000MySQL-Diff-0.60--- abstract: 'Generates a database upgrade instruction set' author: - 'Adam Spiers' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: MySQL-Diff requires: Carp: '0' Data::Dumper: '0' Exporter: '0' File::Slurp: '0' FindBin: '0' Getopt::Long: '0' IO::File: '0' String::ShellQuote: '0' base: '0' lib: '0' perl: '5.006' strict: '0' warnings: '0' resources: bugtracker: https://github.com/aspiers/mysqldiff/issues repository: https://github.com/aspiers/mysqldiff version: '0.60' x_generated_by_perl: v5.26.0 x_serialization_backend: 'YAML::Tiny version 1.73' MANIFEST100644000000000000 72213305551767 13560 0ustar00rootroot000000000000MySQL-Diff-0.60# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. BUGS CONTRIBUTING.md Changes INSTALL.md LICENSE MANIFEST META.json META.yml Makefile.PL Makefile.test README.md bin/mysqldiff dist.ini lib/MySQL/Diff.pm lib/MySQL/Diff/Database.pm lib/MySQL/Diff/Table.pm lib/MySQL/Diff/Utils.pm t/01use.t t/all.t t/regression-rt-77002.t t/regression-rt-79976.t xt/90podtest.t xt/91podcover.t xt/94metatest.t xt/95kwalitee.t xt/96perl_minimum_version.t README.md100644000000000000 317613305551767 13734 0ustar00rootroot000000000000MySQL-Diff-0.60MySQL-Diff ========== MySQL-Diff is a suite of Perl modules and accompanying CLI script `mysqldiff` for comparing the schemas of two MySQL/MariaDB databases. Prerequisites ------------- This suite requires Perl 5.14 or higher and a MySQL compatible suite of client utilities (mysql and mysqldump). You need at least Perl 5.14 to be able to install the current version of `Dist::Zilla`; however, the module proper will probably make do with a lesser version. Availability ------------ This GitHub repo contains the latest code. The latest released version of MySQL-Diff used to be available from - http://adamspiers.org/computing/mysqldiff/ and from the Comprehensive Perl Archive Network (CPAN). Visit to find a CPAN site near you. Installation ------------ See the [`INSTALL.md`](INSTALL.md) file. Documentation ------------- - Homepage: http://adamspiers.org/computing/mysqldiff/ - Documentation at CPAN: http://search.cpan.org/dist/MySQL-Diff/ Support ------- Patches should be sent as pull requests to http://github.com/aspiers/mysqldiff Please see the [`CONTRIBUTING.md`](CONTRIBUTING.md) file for more information. New bug reports and feature requests ------------------------------------ https://github.com/aspiers/mysqldiff/issues Other known bugs ---------------- See https://rt.cpan.org/Public/Dist/Display.html?Name=MySQL-Diff License ------- This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright --------- (c) 2000-2016 Adam Spiers and other contributors (as shown by the git history); all rights reserved. 01use.t100644000000000000 30713305551767 14013 0ustar00rootroot000000000000MySQL-Diff-0.60/t#!/usr/bin/perl -w use strict; use Test::More tests => 4; BEGIN { use_ok( 'MySQL::Diff' ); use_ok( 'MySQL::Diff::Database' ); use_ok( 'MySQL::Diff::Table' ); use_ok( 'MySQL::Diff::Utils' ); } META.json100644000000000000 322513305551767 14071 0ustar00rootroot000000000000MySQL-Diff-0.60{ "abstract" : "Generates a database upgrade instruction set", "author" : [ "Adam Spiers" ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "MySQL-Diff", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "File::Copy" : "0", "Test::Kwalitee" : "0", "Test::More" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Data::Dumper" : "0", "Exporter" : "0", "File::Slurp" : "0", "FindBin" : "0", "Getopt::Long" : "0", "IO::File" : "0", "String::ShellQuote" : "0", "base" : "0", "lib" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/aspiers/mysqldiff/issues" }, "repository" : { "type" : "git", "url" : "https://github.com/aspiers/mysqldiff", "web" : "https://github.com/estrabd/mysqldiff" } }, "version" : "0.60", "x_generated_by_perl" : "v5.26.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.02" } INSTALL.md100644000000000000 330713305551767 14101 0ustar00rootroot000000000000MySQL-Diff-0.60#Installation instructions First please consult the [README](README.md) to check that you have a new enough version of Perl. (N.B. the rest of this document looks a great deal more complicated than it actually is, mainly because I'm trying to encourage people to do the Right Things by using CPANPLUS instead of CPAN, and Module::Build instead of ExtUtils::MakeMaker.) "Automatic" installation via CPANPLUS.pm or CPAN.pm ========================================================================= Installation from either of the recommended installers can be performed at the command line, with either of the two following commands: $ perl -MCPANPLUS -e 'install MySQL::Diff' $ perl -MCPAN -e 'install MySQL::Diff' Although CPAN.pm is the default installer for many, with the release of Perl 5.10, CPANPLUS.pm is now also available in core. However, if you use an earlier version of Perl, you can install CPANPLUS from the CPAN with the following command: $ perl -MCPAN -e 'install CPANPLUS' "Manual" installation ========================================================================= First ensure you have `File::Slurp` installed. Install also `Dist::Zilla` via cpanm install Dist::Zilla Install dependencies with dzil authordeps --missing | cpanm And then dzil listdeps --missing | cpanm Build and test dzil build dzil test Please bear in mind that this module needs a working Mysql installation; those tests needing it will be skipped if it is not present. And if everything is OK, dzil install And finally ... ========================================================================= Note that the test suite will not run properly unless you have a MySQL server which it can connect to. Makefile.PL100644000000000000 274513305551767 14430 0ustar00rootroot000000000000MySQL-Diff-0.60# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use 5.006; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Generates a database upgrade instruction set", "AUTHOR" => "Adam Spiers", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "MySQL-Diff", "EXE_FILES" => [ "bin/mysqldiff" ], "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.006", "NAME" => "MySQL::Diff", "PREREQ_PM" => { "Carp" => 0, "Data::Dumper" => 0, "Exporter" => 0, "File::Slurp" => 0, "FindBin" => 0, "Getopt::Long" => 0, "IO::File" => 0, "String::ShellQuote" => 0, "base" => 0, "lib" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Test::More" => 0 }, "VERSION" => "0.60", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Data::Dumper" => 0, "Exporter" => 0, "File::Slurp" => 0, "FindBin" => 0, "Getopt::Long" => 0, "IO::File" => 0, "String::ShellQuote" => 0, "Test::More" => 0, "base" => 0, "lib" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Makefile.test100644000000000000 4113305551767 15017 0ustar00rootroot000000000000MySQL-Diff-0.60test: PERL5LIB=./lib prove ./t bin000755000000000000 013305551767 13056 5ustar00rootroot000000000000MySQL-Diff-0.60mysqldiff100755000000000000 2146213305551767 15167 0ustar00rootroot000000000000MySQL-Diff-0.60/bin#!/usr/bin/perl -w =head1 NAME mysqldiff - compare MySQL database schemas =head1 SYNOPSIS mysqldiff [B] B B mysqldiff --help =head1 DESCRIPTION F is a Perl script front-end to the L module L which compares the data structures (i.e. schema / table definitions) of two L databases, and returns the differences as a sequence of MySQL commands suitable for piping into F which will transform the structure of the first database to be identical to that of the second (I F and F). Database structures can be compared whether they are files containing table definitions or existing databases, local or remote. B The program makes I attempt to compare any of the data which may be stored in the databases. It is purely for comparing the table definitions. I have no plans to implement data comparison; it is a complex problem and I have no need of such functionality anyway. However there is another program L which does this, and is based on an older program called F which seems to have vanished off the 'net. For PostgreSQL there are similar tools such as L and L. =head1 EXAMPLES # compare table definitions in two files mysqldiff db1.mysql db2.mysql # compare table definitions in a file 'db1.mysql' with a database 'db2' mysqldiff db1.mysql db2 # interactively upgrade schema of database 'db1' to be like the # schema described in the file 'db2.mysql' mysqldiff -A db1 db2.mysql # compare table definitions in two databases on a remote machine mysqldiff --host=remote.host.com --user=myaccount db1 db2 # compare table definitions in a local database 'foo' with a # database 'bar' on a remote machine, when a file foo already # exists in the current directory mysqldiff --host2=remote.host.com --password=secret db:foo bar =head1 OPTIONS =over 4 =item C<-?, --help> show usage =item C<-A, --apply> interactively patch database1 to match database2 =item C<-B, --batch-apply> non-interactively patch database1 to match database2 =item C<-d, --debug[=N]> enable debugging [level N, default 1] =item C<-l, --list-tables> output the list off all used tables =item C<-o, --only-both> only output changes for tables in both databases =item C<-k, --keep-old-tables> don't output DROP TABLE commands =item C<-c, --keep-old-columns> don't output DROP COLUMN commands =item C<-n, --no-old-defs> suppress comments describing old definitions =item C<-t, --table-re=REGEXP> restrict comparisons to tables matching REGEXP =item C<-i, --tolerant> ignore DEFAULT, AUTO_INCREMENT, COLLATE, and formatting changes =item C<-S, --single-transaction> perform DB dump in transaction For more info see: http://dev.mysql.com/doc/refman/en/mysqldump.html#option_mysqldump_single-transaction =item C<-h, --host=[hostname]> connect to host =item C<-P, --port=[port]> use this port for connection =item C<-u, --user=[user]> user for login if not current user =item C<-p, --password[=password]> password to use when connecting to server =item C<-s, --socket=...> socket to use when connecting to server =back =head2 For only, where N == 1 or 2 =over 4 =item C<--hostN=[hostN]> connect to host =item C<--portN=[portN]> use this port for connection =item C<--userN=[userN]> user for login if not current user =item C<--passwordN[=passwordN]> password to use when connecting to server =item C<--socketN=[socketN]> socket to use when connecting to server =back =head1 INTERNALS For both of the database structures being compared, the following happens: =over 4 =item If the argument is a valid filename, the file is used to create a temporary database which C is run on to obtain the table definitions in canonicalised form. The temporary database is then dropped. (The temporary database is named C because default MySQL permissions allow anyone to create databases beginning with the prefix C.) =item If the argument is a database, C is run directly on it. =item Where authentication is required, the hostname, username, and password given by the corresponding options are used (type C for more information). =item Each set of table definitions is now parsed into tables, and fields and index keys within those tables; these are compared, and the differences outputted in the form of MySQL statements. =back =cut use strict; use 5.006; # due to 'our' and qr// use FindBin qw($RealBin $Script); use lib $RealBin; use Getopt::Long qw(:config no_ignore_case); use IO::File; use String::ShellQuote qw(shell_quote); use MySQL::Diff; my %opts = (); GetOptions(\%opts, "help|?", "debug|d:i", "apply|A", "batch-apply|B", "keep-old-tables|k", "keep-old-columns|c", "no-old-defs|n", "only-both|o", "table-re|t=s", "host|h=s", "port|P=s", "socket|s=s", "user|u=s", "password|p:s", "host1=s", "port1=s", "socket1=s", "user1=s", "password1:s", "host2=s", "port2=s", "socket2=s", "user2=s", "password2:s", "tolerant|i", "single-transaction|S", "list-tables|l" ) or usage(); usage() if (@ARGV != 2 or $opts{help}); $opts{debug} ||= 0; my $md = MySQL::Diff->new(%opts); for my $num (1, 2) { my $new_db = $md->register_db($ARGV[$num-1], $num); usage($new_db) unless ref $new_db; } $| = 1; my $diffs = $md->diff(); print $diffs; apply($md, $diffs) if $opts{apply} || $opts{'batch-apply'}; exit 0; ############################################################################## sub usage { print STDERR @_, "\n" if @_; die < Options: -?, --help show this help -A, --apply interactively patch database1 to match database2 -B, --batch-apply non-interactively patch database1 to match database2 -d, --debug[=N] enable debugging [level N, default 1] -l, --list-tables output the list off all used tables -o, --only-both only output changes for tables in both databases -k, --keep-old-tables don't output DROP TABLE commands -c, --keep-old-columns don't output DROP COLUMN commands -n, --no-old-defs suppress comments describing old definitions -t, --table-re=REGEXP restrict comparisons to tables matching REGEXP -i, --tolerant ignore DEFAULT, AUTO_INCREMENT, COLLATE, and formatting changes -S, --single-transaction perform DB dump in transaction -h, --host=... connect to host -P, --port=... use this port for connection -u, --user=... user for login if not current user -p, --password[=...] password to use when connecting to server -s, --socket=... socket to use when connecting to server for only, where N == 1 or 2, --hostN=... connect to host --portN=... use this port for connection --userN=... user for login if not current user --passwordN[=...] password to use when connecting to server --socketN=... socket to use when connecting to server Databases can be either files or database names. If there is an ambiguity, the file will be preferred; to prevent this prefix the database argument with `db:'. EOF } sub apply { my ($md, $diffs) = @_; if (! $diffs) { print "No differences to apply.\n"; return; } my $db0 = $md->db1->name; if ($md->db1->source_type ne 'db') { die "$db0 is not a database; cannot apply changes.\n"; } unless ($opts{'batch-apply'}) { print "\nApply above changes to $db0 [y/N] ? "; print "\n(CAUTION! Changes contain DROP TABLE commands.) " if $diffs =~ /\bDROP TABLE\b/i; my $reply = ; return unless $reply =~ /^y(es)?$/i; } print "Applying changes ... "; my $args_ref = $md->db1->auth_args; unshift @$args_ref, q{mysql}; push @$args_ref, $db0; my $pipe = shell_quote @$args_ref; my $fh = IO::File->new("|$pipe") or die "Couldn't open pipe to '$pipe': $!\n"; print $fh $diffs; $fh->close or die "Couldn't close pipe: $!\n"; print "done.\n"; } =head1 BUGS, DEVELOPMENT, CONTRIBUTING See L. =head1 COPYRIGHT AND LICENSE Copyright (c) 2000-2016 Adam Spiers. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L, L, L, L =head1 AUTHOR Adam Spiers =cut xt000755000000000000 013305551767 12741 5ustar00rootroot000000000000MySQL-Diff-0.6090podtest.t100644000000000000 41413305551767 15100 0ustar00rootroot000000000000MySQL-Diff-0.60/xtuse Test::More; # Skip if doing a regular install plan skip_all => "Author tests not required for installation" unless ( $ENV{AUTOMATED_TESTING} ); eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); CONTRIBUTING.md100644000000000000 422713305551767 14704 0ustar00rootroot000000000000MySQL-Diff-0.60# Good reading - https://www.igvita.com/2011/12/19/dont-push-your-pull-requests/ - http://blog.adamspiers.org/2012/11/10/7-principles-for-contributing-patches-to-software-projects/ # NOTE: All changes must add/update tests (NO EXCEPTIONS) All new features should include new unit or integration tests to exercise them thoroughly. If fixing a bug, please add a regression test. # How to contribute Contributing is easy. First check your issue hasn't already been reported on [CPAN](https://rt.cpan.org/Public/Dist/Display.html?Name=MySQL-Diff) or [GitHub](https://github.com/aspiers/mysqldiff/issues). Then proceed appropriately: 1. [File a new issue](https://github.com/aspiers/mysqldiff/issues/new) 2. Fork the main repo 3. Create an issue branch, e.g., "Issue-XX-blah-foo-derp" 4. Make commits of logical units (see below). 5. Check for unnecessary whitespace with `git diff --check` before committing. 6. Make sure your commit messages summarize your changes well enough. 7. Make sure you have added the necessary tests for your changes. 8. Issue a proper pull request. # Commits, pull request, and commit message format See [this page](https://wiki.openstack.org/wiki/GitCommitMessages#Structural_split_of_changes) for some excellent advice on structuring commits correctly. 1. Please squash commits which relate to the same thing. 2. Do not mix new features together, or with bug fixes. 3. Use a structured commit messsage. For example, Fixed the foobar bug with the flim-flam. Issue-XX: Made changes to the flux memristor so that the space time continuum would remain consisitent for the key constraint mechanism. Added a few unit tests to ensure the inversion of time remained consistent in all past and future versions of this utility. # Using Dist::Zilla This module uses Dist::Zilla to manage releases. Please see `./dist.ini`; To roll a build; 1. Bump version number in dist.ini 2. Bump $VERSION in all .pm files 3. Run `dzil clean && dzil test && dzil build` 4. To push a release to CPAN, `dzil release` (but please ask a committer first). # Questions When in doubt, issue a pull request. Feel free to email B. Estrade . 94metatest.t100644000000000000 116613305551767 15275 0ustar00rootroot000000000000MySQL-Diff-0.60/xtuse Test::More; use MySQL::Diff; # Skip if doing a regular install plan skip_all => "Author tests not required for installation" unless ( $ENV{AUTOMATED_TESTING} ); eval "use Test::CPAN::Meta 0.16"; plan skip_all => "Test::CPAN::Meta 0.16 required for testing META.yml" if $@; plan no_plan; my $yaml = meta_spec_ok(undef,undef,@_); is($yaml->{version},$MySQL::Diff::VERSION, 'META.yml distribution version matches'); if($yaml->{provides}) { for my $mod (keys %{$yaml->{provides}}) { is($yaml->{provides}{$mod}{version},$MySQL::Diff::VERSION, "META.yml entry [$mod] version matches"); } } 95kwalitee.t100644000000000000 104413305551767 15250 0ustar00rootroot000000000000MySQL-Diff-0.60/xt# -*- perl -*- use strict; use warnings; use Test::More; use Config; plan skip_all => 'This test is only run for the module author' unless -d '.git' || $ENV{AUTOMATED_TESTING}; plan skip_all => 'Test::Kwalitee fails with clang -faddress-sanitizer' if $Config{ccflags} =~ /(-fsanitize=address|-faddress-sanitizer)/; use File::Copy 'cp'; cp('MYMETA.yml','META.yml') if -e 'MYMETA.yml' and !-e 'META.yml'; eval { require Test::Kwalitee; Test::Kwalitee->import; }; plan skip_all => "Test::Kwalitee needed for testing kwalitee" if $@; 91podcover.t100644000000000000 45313305551767 15243 0ustar00rootroot000000000000MySQL-Diff-0.60/xtuse Test::More; # Skip if doing a regular install plan skip_all => "Author tests not required for installation" unless ( $ENV{AUTOMATED_TESTING} ); eval "use Test::Pod::Coverage 0.08"; plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@; all_pod_coverage_ok(); MySQL000755000000000000 013305551767 14021 5ustar00rootroot000000000000MySQL-Diff-0.60/libDiff.pm100644000000000000 3777513305551767 15432 0ustar00rootroot000000000000MySQL-Diff-0.60/lib/MySQLpackage MySQL::Diff; =head1 NAME MySQL::Diff - Generates a database upgrade instruction set =head1 SYNOPSIS use MySQL::Diff; my $md = MySQL::Diff->new( %options ); my $db1 = $md->register_db($ARGV[0], 1); my $db2 = $md->register_db($ARGV[1], 2); my $diffs = $md->diff(); =head1 DESCRIPTION Generates the SQL instructions required to upgrade the first database to match the second. =cut use warnings; use strict; our $VERSION = '0.60'; # ------------------------------------------------------------------------------ # Libraries use MySQL::Diff::Database; use MySQL::Diff::Utils qw(debug debug_level debug_file); use Data::Dumper; # ------------------------------------------------------------------------------ =head1 METHODS =head2 Constructor =over 4 =item new( %options ) Instantiate the objects, providing the command line options for database access and process requirements. =back =cut sub new { my $class = shift; my %hash = @_; my $self = {}; bless $self, ref $class || $class; $self->{opts} = \%hash; if($hash{debug}) { debug_level($hash{debug}) ; delete $hash{debug}; } if($hash{debug_file}) { debug_file($hash{debug_file}) ; delete $hash{debug_file}; } debug(3,"\nconstructing new MySQL::Diff"); return $self; } =head2 Public Methods Fuller documentation will appear here in time :) =over 4 =item * register_db($name,$inx) Reference the database, and setup a connection. The name can be an already existing 'MySQL::Diff::Database' database object. The index can be '1' or '2', and refers both to the order of the diff, and to the host, port, username and password arguments that have been supplied. =cut sub register_db { my ($self, $name, $inx) = @_; return unless $inx == 1 || $inx == 2; my $db = ref $name eq 'MySQL::Diff::Database' ? $name : $self->_load_database($name,$inx); $self->{databases}[$inx-1] = $db; return $db; } =item * db1() =item * db2() Return the first and second databases registered via C. =cut sub db1 { shift->{databases}->[0] } sub db2 { shift->{databases}->[1] } =item * diff() Performs the diff, returning a string containing the commands needed to change the schema of the first database into that of the second. =back =cut sub diff { my $self = shift; my @changes; my %used_tables = (); debug(1, "\ncomparing databases"); for my $table1 ($self->db1->tables()) { my $name = $table1->name(); $used_tables{'-- '. $name} = 1; debug(4, "table 1 $name = ".Dumper($table1)); debug(2,"looking at tables called '$name'"); if (my $table2 = $self->db2->table_by_name($name)) { debug(3,"comparing tables called '$name'"); push @changes, $self->_diff_tables($table1, $table2); } else { debug(3,"table '$name' dropped"); push @changes, "DROP TABLE $name;\n\n" unless $self->{opts}{'only-both'} || $self->{opts}{'keep-old-tables'}; } } for my $table2 ($self->db2->tables()) { my $name = $table2->name(); $used_tables{'-- '. $name} = 1; debug(4, "table 2 $name = ".Dumper($table2)); if (! $self->db1->table_by_name($name)) { debug(3,"table '$name' added"); debug(4,"table '$name' added '".$table2->def()."'"); push @changes, $table2->def() . "\n" unless $self->{opts}{'only-both'}; } } debug(4,join '', @changes); my $out = ''; if (@changes) { if (!$self->{opts}{'list-tables'}) { $out .= $self->_diff_banner(); } else { $out .= "-- TABLES LIST \n"; $out .= join "\n", keys %used_tables; $out .= "\n-- END OF TABLES LIST \n"; } $out .= join '', @changes; } return $out; } # ------------------------------------------------------------------------------ # Private Methods sub _diff_banner { my ($self) = @_; my $summary1 = $self->db1->summary(); my $summary2 = $self->db2->summary(); my $opt_text = join ', ', map { $self->{opts}{$_} eq '1' ? $_ : "$_=$self->{opts}{$_}" } keys %{$self->{opts}}; $opt_text = "## Options: $opt_text\n" if $opt_text; my $now = scalar localtime(); return <_diff_fields(@_), $self->_diff_indices(@_), $self->_diff_primary_key(@_), $self->_diff_foreign_key(@_), $self->_diff_options(@_) ); $changes[-1] =~ s/\n*$/\n/ if (@changes); return @changes; } sub _diff_fields { my ($self, $table1, $table2) = @_; my $name1 = $table1->name(); my $fields1 = $table1->fields; my $fields2 = $table2->fields; return () unless $fields1 || $fields2; my @changes; if($fields1) { for my $field (keys %$fields1) { debug(3,"table1 had field '$field'"); my $f1 = $fields1->{$field}; my $f2 = $fields2->{$field}; if ($fields2 && $f2) { if ($self->{opts}{tolerant}) { for ($f1, $f2) { s/ COLLATE [\w_]+//gi; } } if ($f1 ne $f2) { if (not $self->{opts}{tolerant} or (($f1 !~ m/$f2\(\d+,\d+\)/) and ($f1 ne "$f2 DEFAULT '' NOT NULL") and ($f1 ne "$f2 NOT NULL") )) { debug(3,"field '$field' changed"); my $change = "ALTER TABLE $name1 CHANGE COLUMN $field $field $f2;"; $change .= " # was $f1" unless $self->{opts}{'no-old-defs'}; $change .= "\n"; push @changes, $change; } } } elsif (!$self->{opts}{'keep-old-columns'}) { debug(3,"field '$field' removed"); my $change = "ALTER TABLE $name1 DROP COLUMN $field;"; $change .= " # was $fields1->{$field}" unless $self->{opts}{'no-old-defs'}; $change .= "\n"; push @changes, $change; } } } if($fields2) { for my $field (keys %$fields2) { unless($fields1 && $fields1->{$field}) { debug(3,"field '$field' added"); my $changes = "ALTER TABLE $name1 ADD COLUMN $field $fields2->{$field}"; if ($table2->is_auto_inc($field)) { if ($table2->isa_primary($field)) { $changes .= ' PRIMARY KEY'; } elsif ($table2->is_unique($field)) { $changes .= ' UNIQUE KEY'; } } push @changes, "$changes;\n"; } } } return @changes; } sub _diff_indices { my ($self, $table1, $table2) = @_; my $name1 = $table1->name(); my $indices1 = $table1->indices(); my $indices2 = $table2->indices(); return () unless $indices1 || $indices2; my @changes; if($indices1) { for my $index (keys %$indices1) { debug(3,"table1 had index '$index'"); my $old_type = $table1->is_unique($index) ? 'UNIQUE' : $table1->is_fulltext($index) ? 'FULLTEXT INDEX' : 'INDEX'; if ($indices2 && $indices2->{$index}) { if( ($indices1->{$index} ne $indices2->{$index}) or ($table1->is_unique($index) xor $table2->is_unique($index)) or ($table1->is_fulltext($index) xor $table2->is_fulltext($index)) ) { debug(3,"index '$index' changed"); my $new_type = $table2->is_unique($index) ? 'UNIQUE' : $table2->is_fulltext($index) ? 'FULLTEXT INDEX' : 'INDEX'; my $changes = "ALTER TABLE $name1 DROP INDEX $index;"; $changes .= " # was $old_type ($indices1->{$index})" unless $self->{opts}{'no-old-defs'}; $changes .= "\nALTER TABLE $name1 ADD $new_type $index ($indices2->{$index});\n"; push @changes, $changes; } } else { debug(3,"index '$index' removed"); my $auto = _check_for_auto_col($table2, $indices1->{$index}, 1) || ''; my $changes = $auto ? _index_auto_col($table1, $indices1->{$index}) : ''; $changes .= "ALTER TABLE $name1 DROP INDEX $index;"; $changes .= " # was $old_type ($indices1->{$index})" unless $self->{opts}{'no-old-defs'}; $changes .= "\n"; push @changes, $changes; } } } if($indices2) { for my $index (keys %$indices2) { next if($indices1 && $indices1->{$index}); next if( !$table2->isa_primary($index) && $table2->is_unique($index) && _key_covers_auto_col($table2, $index) ); debug(3,"index '$index' added"); my $new_type = $table2->is_unique($index) ? 'UNIQUE' : 'INDEX'; push @changes, "ALTER TABLE $name1 ADD $new_type $index ($indices2->{$index});\n"; } } return @changes; } sub _diff_primary_key { my ($self, $table1, $table2) = @_; my $name1 = $table1->name(); my $primary1 = $table1->primary_key(); my $primary2 = $table2->primary_key(); return () unless $primary1 || $primary2; my @changes; if ($primary1 && ! $primary2) { debug(3,"primary key '$primary1' dropped"); my $changes = _index_auto_col($table2, $primary1); $changes .= "ALTER TABLE $name1 DROP PRIMARY KEY;"; $changes .= " # was $primary1" unless $self->{opts}{'no-old-defs'}; return ( "$changes\n" ); } if (! $primary1 && $primary2) { debug(3,"primary key '$primary2' added"); return () if _key_covers_auto_col($table2, $primary2); return ("ALTER TABLE $name1 ADD PRIMARY KEY $primary2;\n"); } if ($primary1 ne $primary2) { debug(3,"primary key changed"); my $auto = _check_for_auto_col($table2, $primary1) || ''; my $changes = $auto ? _index_auto_col($table2, $auto) : ''; $changes .= "ALTER TABLE $name1 DROP PRIMARY KEY;"; $changes .= " # was $primary1" unless $self->{opts}{'no-old-defs'}; $changes .= "\nALTER TABLE $name1 ADD PRIMARY KEY $primary2;\n"; $changes .= "ALTER TABLE $name1 DROP INDEX $auto;\n" if($auto); push @changes, $changes; } return @changes; } sub _diff_foreign_key { my ($self, $table1, $table2) = @_; my $name1 = $table1->name(); my $fks1 = $table1->foreign_key(); my $fks2 = $table2->foreign_key(); return () unless $fks1 || $fks2; my @changes; if($fks1) { for my $fk (keys %$fks1) { debug(1,"$name1 has fk '$fk'"); if ($fks2 && $fks2->{$fk}) { if($fks1->{$fk} ne $fks2->{$fk}) { debug(1,"foreign key '$fk' changed"); my $changes = "ALTER TABLE $name1 DROP FOREIGN KEY $fk;"; $changes .= " # was CONSTRAINT $fk $fks1->{$fk}" unless $self->{opts}{'no-old-defs'}; $changes .= "\nALTER TABLE $name1 ADD CONSTRAINT $fk FOREIGN KEY $fks2->{$fk};\n"; push @changes, $changes; } } else { debug(1,"foreign key '$fk' removed"); my $changes .= "ALTER TABLE $name1 DROP FOREIGN KEY $fk;"; $changes .= " # was CONSTRAINT $fk $fks1->{$fk}" unless $self->{opts}{'no-old-defs'}; $changes .= "\n"; push @changes, $changes; } } } if($fks2) { for my $fk (keys %$fks2) { next if($fks1 && $fks1->{$fk}); debug(1, "foreign key '$fk' added"); push @changes, "ALTER TABLE $name1 ADD CONSTRAINT $fk FOREIGN KEY $fks2->{$fk};\n"; } } return @changes; } # If we're about to drop a composite (multi-column) index, we need to # check whether any of the columns in the composite index are # auto_increment; if so, we have to add an index for that # auto_increment column *before* dropping the composite index, since # auto_increment columns must always be indexed. sub _check_for_auto_col { my ($table, $fields, $primary) = @_; my @fields = _fields_from_key($fields); for my $field (@fields) { next if($table->field($field) !~ /auto_increment/i); next if($table->isa_index($field)); next if($primary && $table->isa_primary($field)); return $field; } return; } sub _fields_from_key { my $key = shift; $key =~ s/^\s*\((.*)\)\s*$/$1/g; # strip brackets if any split /\s*,\s*/, $key; } sub _key_covers_auto_col { my ($table, $key) = @_; my @fields = _fields_from_key($key); for my $field (@fields) { return 1 if $table->is_auto_inc($field); } return; } sub _index_auto_col { my ($table, $field) = @_; my $name = $table->name; return "ALTER TABLE $name ADD INDEX ($field); # auto columns must always be indexed\n"; } sub _diff_options { my ($self, $table1, $table2) = @_; my $name = $table1->name(); my $options1 = $table1->options(); my $options2 = $table2->options(); return () unless $options1 || $options2; my @changes; if ($self->{opts}{tolerant}) { for ($options1, $options2) { s/ AUTO_INCREMENT=\d+//gi; s/ COLLATE=[\w_]+//gi; } } if ($options1 ne $options2) { my $change = "ALTER TABLE $name $options2;"; $change .= " # was " . ($options1 || 'blank') unless $self->{opts}{'no-old-defs'}; $change .= "\n"; push @changes, $change; } return @changes; } sub _load_database { my ($self, $arg, $authnum) = @_; debug(2, "parsing arg $authnum: '$arg'\n"); my %auth; for my $auth (qw/dbh host port user password socket/) { $auth{$auth} = $self->{opts}{"$auth$authnum"} || $self->{opts}{$auth}; delete $auth{$auth} unless $auth{$auth}; } if ($arg =~ /^db:(.*)/) { return MySQL::Diff::Database->new(db => $1, auth => \%auth, 'single-transaction' => $self->{opts}{'single-transaction'}, 'table-re' => $self->{opts}{'table-re'}); } if ($self->{opts}{"dbh"} || $self->{opts}{"host$authnum"} || $self->{opts}{"port$authnum"} || $self->{opts}{"user$authnum"} || $self->{opts}{"password$authnum"} || $self->{opts}{"socket$authnum"}) { return MySQL::Diff::Database->new(db => $arg, auth => \%auth, 'single-transaction' => $self->{opts}{'single-transaction'}, 'table-re' => $self->{opts}{'table-re'}); } if (-f $arg) { return MySQL::Diff::Database->new(file => $arg, auth => \%auth, 'single-transaction' => $self->{opts}{'single-transaction'}, 'table-re' => $self->{opts}{'table-re'}); } my %dbs = MySQL::Diff::Database::available_dbs(%auth); debug(2, " available databases: ", (join ', ', keys %dbs), "\n"); if ($dbs{$arg}) { return MySQL::Diff::Database->new(db => $arg, auth => \%auth, 'single-transaction' => $self->{opts}{'single-transaction'}, 'table-re' => $self->{opts}{'table-re'}); } warn "'$arg' is not a valid file or database.\n"; return; } sub _debug_level { my ($self,$level) = @_; debug_level($level); } 1; __END__ =head1 COPYRIGHT AND LICENSE Copyright (c) 2000-2016 Adam Spiers. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L =head1 AUTHOR Adam Spiers =cut regression-rt-77002.t100644000000000000 210513305551767 16354 0ustar00rootroot000000000000MySQL-Diff-0.60/t#!/usr/bin/perl -w use strict; use Test::More tests => 4; # checks for regression to https://rt.cpan.org/Public/Bug/Display.html?id=77002 BEGIN { use_ok('MySQL::Diff::Table'); } my $table_def = < [ def => $table_def ]; ok $table->{name} eq 'table_1', 'ensuring table name parsed properly'; my $duplicate_field_table_def = <new( def => $duplicate_field_table_def ); }; my $expected = qq{definition for field 'id' duplicated in table 'table_1'}; my @g = split /\n/, $@; my $got = $g[0]; ok $got eq $expected, 'ensuring table name returned in duplicate field name error'; __END__ regression-rt-79976.t100644000000000000 62713305551767 16371 0ustar00rootroot000000000000MySQL-Diff-0.60/t#!/usr/bin/perl -w use strict; use Test::More tests => 4; # checks for regression to https://rt.cpan.org/Public/Bug/Display.html?id=79976 use_ok('MySQL::Diff::Database'); can_ok 'MySQL::Diff::Database', 'auth_args'; my $out = `mysqldump test`; SKIP: { skip q{`mysqldump test` failed.}, 2 if $? != 0; my $db = new_ok 'MySQL::Diff::Database' => [ db => 'test' ]; can_ok $db, 'auth_args'; } __END__ Diff000755000000000000 013305551767 14671 5ustar00rootroot000000000000MySQL-Diff-0.60/lib/MySQLUtils.pm100644000000000000 454113305551767 16473 0ustar00rootroot000000000000MySQL-Diff-0.60/lib/MySQL/Diffpackage MySQL::Diff::Utils; =head1 NAME MySQL::Diff::Utils - Supporting functions for MySQL:Diff =head1 SYNOPSIS use MySQL::Diff::Utils qw(debug_level debug); =head1 DESCRIPTION Currently contains the debug message handling routines. =cut use warnings; use strict; our $VERSION = '0.60'; # ------------------------------------------------------------------------------ # Libraries use IO::File; # ------------------------------------------------------------------------------ # Export Components use base qw(Exporter); our @EXPORT_OK = qw(debug_file debug_level debug); # ------------------------------------------------------------------------------ =head1 FUNCTIONS =head2 Public Functions Fuller documentation will appear here in time :) =over 4 =item * debug_file( $file ) Accessor to set/get the current debug log file. =item * debug_level( $level ) Accessor to set/get the current debug level for messages. Current levels range from 1 to 4, with 1 being very brief processing messages, 2 providing high level process flow messages, 3 providing low level process flow messages and 4 providing data dumps, etc where appropriate. =item * debug Writes to debug log file (if specified) and STDERR the given message, provided is equal to or lower than the current debug level. =back =cut { my $debug_file; my $debug_level = 0; sub debug_file { my ($new_debug_file) = @_; $debug_file = $new_debug_file if defined $new_debug_file; return $debug_file; } sub debug_level { my ($new_debug_level) = @_; $debug_level = $new_debug_level if defined $new_debug_level; return $debug_level; } sub debug { my $level = shift; return unless($debug_level >= $level && @_); if($debug_file) { if(my $fh = IO::File->new($debug_file, 'a+')) { print $fh @_,"\n"; $fh->close; return; } } print STDERR @_,"\n"; } } 1; __END__ =head1 COPYRIGHT AND LICENSE Copyright (c) 2000-2016 Adam Spiers. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L =head1 AUTHOR Adam Spiers =cut Table.pm100644000000000000 1733613305551767 16450 0ustar00rootroot000000000000MySQL-Diff-0.60/lib/MySQL/Diffpackage MySQL::Diff::Table; =head1 NAME MySQL::Diff::Table - Table Definition Class =head1 SYNOPSIS use MySQL::Diff::Table my $db = MySQL::Diff::Database->new(%options); my $def = $db->def(); my $name = $db->name(); my $field = $db->field(); my $fields = $db->fields(); # %$fields my $primary_key = $db->primary_key(); my $indices = $db->indices(); # %$indices my $options = $db->options(); my $isfield = $db->isa_field($field); my $isprimary = $db->isa_primary($field); my $isindex = $db->isa_index($field); my $isunique = $db->is_unique($field); my $isfulltext = $db->is_fulltext($field); =head1 DESCRIPTION Parses a table definition into component parts. =cut use warnings; use strict; our $VERSION = '0.60'; # ------------------------------------------------------------------------------ # Libraries use Carp qw(:DEFAULT); use MySQL::Diff::Utils qw(debug); # ------------------------------------------------------------------------------ =head1 METHODS =head2 Constructor =over 4 =item new( %options ) Instantiate the objects, providing the command line options for database access and process requirements. =cut sub new { my $class = shift; my %hash = @_; my $self = {}; bless $self, ref $class || $class; $self->{$_} = $hash{$_} for(keys %hash); debug(3,"\nconstructing new MySQL::Diff::Table"); croak "MySQL::Diff::Table::new called without def params" unless $self->{def}; $self->_parse; return $self; } =back =head2 Public Methods Fuller documentation will appear here in time :) =over 4 =item * def Returns the table definition as a string. =item * name Returns the name of the current table. =item * field Returns the current field definition of the given field. =item * fields Returns an array reference to a list of fields. =item * primary_key Returns a hash reference to fields used as primary key fields. =item * indices Returns a hash reference to fields used as index fields. =item * options Returns the additional options added to the table definition. =item * isa_field Returns 1 if given field is used in the current table definition, otherwise returns 0. =item * isa_primary Returns 1 if given field is defined as a primary key, otherwise returns 0. =item * isa_index Returns 1 if given field is used as an index field, otherwise returns 0. =item * is_unique Returns 1 if given field is used as unique index field, otherwise returns 0. =item * is_fulltext Returns 1 if given field is used as fulltext index field, otherwise returns 0. =item * is_auto_inc Returns 1 if given field is defined as an auto increment field, otherwise returns 0. =back =cut sub def { my $self = shift; return $self->{def}; } sub name { my $self = shift; return $self->{name}; } sub field { my $self = shift; return $self->{fields}{$_[0]}; } sub fields { my $self = shift; return $self->{fields}; } sub primary_key { my $self = shift; return $self->{primary_key}; } sub indices { my $self = shift; return $self->{indices}; } sub options { my $self = shift; return $self->{options}; } sub foreign_key { my $self = shift; return $self->{foreign_key}; } sub isa_field { my $self = shift; return $_[0] && $self->{fields}{$_[0]} ? 1 : 0; } sub isa_primary { my $self = shift; return $_[0] && $self->{primary}{$_[0]} ? 1 : 0; } sub isa_index { my $self = shift; return $_[0] && $self->{indices}{$_[0]} ? 1 : 0; } sub is_unique { my $self = shift; return $_[0] && $self->{unique}{$_[0]} ? 1 : 0; } sub is_fulltext { my $self = shift; return $_[0] && $self->{fulltext}{$_[0]} ? 1 : 0; } sub is_auto_inc { my $self = shift; return $_[0] && $self->{auto_inc}{$_[0]} ? 1 : 0; } # ------------------------------------------------------------------------------ # Private Methods sub _parse { my $self = shift; $self->{def} =~ s/`([^`]+)`/$1/gs; # later versions quote names $self->{def} =~ s/\n+/\n/; $self->{lines} = [ grep ! /^\s*$/, split /(?=^)/m, $self->{def} ]; my @lines = @{$self->{lines}}; debug(4,"parsing table def '$self->{def}'"); my $name; if ($lines[0] =~ /^\s*create\s+table\s+(\S+)\s+\(\s*$/i) { $self->{name} = $1; debug(3,"got table name '$self->{name}'"); shift @lines; } else { croak "couldn't figure out table name"; } while (@lines) { $_ = shift @lines; s/^\s*(.*?),?\s*$/$1/; # trim whitespace and trailing commas debug(4,"line: [$_]"); if (/^PRIMARY\s+KEY\s+(.+)$/) { my $primary = $1; croak "two primary keys in table '$self->{name}': '$primary', '$self->{primary_key}'\n" if $self->{primary_key}; debug(4,"got primary key $primary"); $self->{primary_key} = $primary; $primary =~ s/\((.*?)\)/$1/; $self->{primary}{$_} = 1 for(split(/,/, $primary)); next; } if (/^(?:CONSTRAINT\s+(.*)?)?\s+FOREIGN\s+KEY\s+(.*)$/) { my ($key, $val) = ($1, $2); croak "foreign key '$key' duplicated in table '$name'\n" if $self->{foreign_key}{$key}; debug(1,"got foreign key $key"); $self->{foreign_key}{$key} = $val; next; } if (/^(KEY|UNIQUE(?: KEY)?)\s+(\S+?)(?:\s+USING\s+(?:BTREE|HASH|RTREE))?\s*\((.*)\)(?:\s+USING\s+(?:BTREE|HASH|RTREE))?$/) { my ($type, $key, $val) = ($1, $2, $3); croak "index '$key' duplicated in table '$self->{name}'\n" if $self->{indices}{$key}; $self->{indices}{$key} = $val; $self->{unique}{$key} = 1 if($type =~ /unique/i); debug(4, "got ", defined $self->{unique}{$key} ? 'unique ' : '', "index key '$key': ($val)"); next; } if (/^(FULLTEXT(?:\s+KEY|INDEX)?)\s+(\S+?)\s*\((.*)\)$/) { my ($type, $key, $val) = ($1, $2, $3); croak "FULLTEXT index '$key' duplicated in table '$self->{name}'\n" if $self->{fulltext}{$key}; $self->{indices}{$key} = $val; $self->{fulltext}{$key} = 1; debug(4,"got FULLTEXT index '$key': ($val)"); next; } if (/^\)\s*(.*?);$/) { # end of table definition $self->{options} = $1; debug(4,"got table options '$self->{options}'"); last; } if (/^(\S+)\s*(.*)/) { my ($field, $fdef) = ($1, $2); croak "definition for field '$field' duplicated in table '$self->{name}'\n" if $self->{fields}{$field}; $self->{fields}{$field} = $fdef; debug(4,"got field def '$field': $fdef"); next unless $fdef =~ /\s+AUTO_INCREMENT\b/; $self->{auto_inc}{$field} = 1; debug(4,"got AUTO_INCREMENT field '$field'"); next; } croak "unparsable line in definition for table '$self->{name}':\n$_"; } warn "table '$self->{name}' didn't have terminator\n" unless defined $self->{options}; @lines = grep ! m{^/\*!40\d{3} .*? \*/;}, @lines; @lines = grep ! m{^(SET |DROP TABLE)}, @lines; warn "table '$self->{name}' had trailing garbage:\n", join '', @lines if @lines; } 1; __END__ =head1 COPYRIGHT AND LICENSE Copyright (c) 2000-2016 Adam Spiers. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L =head1 AUTHOR Adam Spiers =cut Database.pm100644000000000000 2142513305551767 17117 0ustar00rootroot000000000000MySQL-Diff-0.60/lib/MySQL/Diffpackage MySQL::Diff::Database; =head1 NAME MySQL::Diff::Database - Database Definition Class =head1 SYNOPSIS use MySQL::Diff::Database; my $db = MySQL::Diff::Database->new(%options); my $source = $db->source_type(); my $summary = $db->summary(); my $name = $db->name(); my @tables = $db->tables(); my $table_def = $db->table_by_name($table); my @dbs = MySQL::Diff::Database::available_dbs(); =head1 DESCRIPTION Parses a database definition into component parts. =cut use warnings; use strict; use String::ShellQuote qw(shell_quote); our $VERSION = '0.60'; # ------------------------------------------------------------------------------ # Libraries use Carp qw(:DEFAULT); use File::Slurp; use IO::File; use MySQL::Diff::Utils qw(debug); use MySQL::Diff::Table; # ------------------------------------------------------------------------------ =head1 METHODS =head2 Constructor =over 4 =item new( %options ) Instantiate the objects, providing the command line options for database access and process requirements. =back =cut sub new { my $class = shift; my %p = @_; my $self = {}; bless $self, ref $class || $class; debug(3,"\nconstructing new MySQL::Diff::Database"); my $auth_ref = _auth_args_string(%{$p{auth}}); my $string = shell_quote @$auth_ref; debug(3,"auth args: $string"); $self->{_source}{auth} = $string; $self->{_source}{dbh} = $p{dbh} if $p{dbh}; $self->{'single-transaction'} = $p{'single-transaction'}; $self->{'table-re'} = $p{'table-re'}; if ($p{file}) { $self->_canonicalise_file($p{file}); } elsif ($p{db}) { $self->_read_db($p{db}); } else { confess "MySQL::Diff::Database::new called without db or file params"; } $self->_parse_defs(); return $self; } =head2 Public Methods =over 4 =item * source_type() Returns 'file' if the data source is a text file, and 'db' if connected directly to a database. =cut sub source_type { my $self = shift; return 'file' if $self->{_source}{file}; return 'db' if $self->{_source}{db}; } =item * summary() Provides a summary of the database. =cut sub summary { my $self = shift; if ($self->{_source}{file}) { return "file: " . $self->{_source}{file}; } elsif ($self->{_source}{db}) { my $args = $self->{_source}{auth}; $args =~ tr/-//d; $args =~ s/\bpassword=\S+//; $args =~ s/^\s*(.*?)\s*$/$1/; my $summary = " db: " . $self->{_source}{db}; $summary .= " ($args)" if $args; return $summary; } else { return 'unknown'; } } =item * name() Returns the name of the database. =cut sub name { my $self = shift; return $self->{_source}{file} || $self->{_source}{db}; } =item * tables() Returns a list of tables for the current database. =cut sub tables { my $self = shift; return @{$self->{_tables}}; } =item * table_by_name( $name ) Returns the table definition (see L) for the given table. =cut sub table_by_name { my ($self,$name) = @_; return $self->{_by_name}{$name}; } =back =head1 FUNCTIONS =head2 Public Functions =over 4 =item * available_dbs() Returns a list of the available databases. Note that is used as a function call, not a method call. =cut sub available_dbs { my %auth = @_; my $args_ref = _auth_args_string(%auth); unshift @$args_ref, q{mysqlshow}; # evil but we don't use DBI because I don't want to implement -p properly # not that this works with -p anyway ... my $command = shell_quote @$args_ref; my $fh = IO::File->new("$command |") or die "Couldn't execute '$command': $!\n"; my $dbs_ref = _parse_mysqlshow_from_fh_into_arrayref($fh); $fh->close() or die "$command failed: $!"; return map { $_ => 1 } @{$dbs_ref}; } =back =cut # ------------------------------------------------------------------------------ # Private Methods sub auth_args { return _auth_args_string(); } sub _canonicalise_file { my ($self, $file) = @_; $self->{_source}{file} = $file; debug(2,"fetching table defs from file $file"); # FIXME: option to avoid create-and-dump bit # create a temporary database using defs from file ... # hopefully the temp db is unique! my $temp_db = sprintf "test_mysqldiff-temp-%d_%d_%d", time(), $$, rand(); debug(3,"creating temporary database $temp_db"); my $defs = read_file($file); die "$file contains dangerous command '$1'; aborting.\n" if $defs =~ /;\s*(use|((drop|create)\s+database))\b/i; my $args = $self->{_source}{auth}; my $fh = IO::File->new("| mysql $args") or die "Couldn't execute 'mysql$args': $!\n"; print $fh "\nCREATE DATABASE \`$temp_db\`;\nUSE \`$temp_db\`;\n"; print $fh $defs; $fh->close; # ... and then retrieve defs from mysqldump. Hence we've used # MySQL to massage the defs file into canonical form. $self->_get_defs($temp_db); debug(3,"dropping temporary database $temp_db"); $fh = IO::File->new("| mysql $args") or die "Couldn't execute 'mysql$args': $!\n"; print $fh "DROP DATABASE \`$temp_db\`;\n"; $fh->close; } sub _read_db { my ($self, $db) = @_; $self->{_source}{db} = $db; debug(3, "fetching table defs from db $db"); $self->_get_defs($db); } sub _get_tables_to_dump { my ( $self, $db ) = @_; my $tables_ref = $self->_get_tables_in_db($db); my $compiled_table_re = qr/$self->{'table-re'}/; my @matching_tables = grep { $_ =~ $compiled_table_re } @{$tables_ref}; return join( ' ', @matching_tables ); } sub _get_tables_in_db { my ( $self, $db ) = @_; my $args = $self->{_source}{auth}; # evil but we don't use DBI because I don't want to implement -p properly # not that this works with -p anyway ... my $fh = IO::File->new("mysqlshow $args $db|") or die "Couldn't execute 'mysqlshow $args $db': $!\n"; my $tables_ref = _parse_mysqlshow_from_fh_into_arrayref($fh); $fh->close() or die "mysqlshow $args $db failed: $!"; return $tables_ref; } # Note that is used as a function call, not a method call. sub _parse_mysqlshow_from_fh_into_arrayref { my ($fh) = @_; my @items; while (<$fh>) { next unless /^\| ([\w-]+)/; push @items, $1; } return \@items; } sub _get_defs { my ( $self, $db ) = @_; my $args = $self->{_source}{auth}; my $single_transaction = $self->{'single-transaction'} ? "--single-transaction" : ""; my $tables = ''; #dump all tables by default if ( my $table_re = $self->{'table-re'} ) { $tables = $self->_get_tables_to_dump($db); if ( !length $tables ) { # No tables to dump $self->{_defs} = []; return; } } my $fh = IO::File->new("mysqldump -d $single_transaction $args $db $tables 2>&1 |") or die "Couldn't read ${db}'s table defs via mysqldump: $!\n"; debug( 3, "running mysqldump -d $single_transaction $args $db $tables" ); my $defs = $self->{_defs} = [<$fh>]; $fh->close; my $exit_status = $? >> 8; if ( grep /mysqldump: Got error: .*: Unknown database/, @$defs ) { die <{_tables}; debug(2, "parsing table defs"); my $defs = join '', grep ! /^\s*(\#|--|SET|\/\*)/, @{$self->{_defs}}; $defs =~ s/`//sg; my @tables = split /(?=^\s*(?:create|alter|drop)\s+table\s+)/im, $defs; $self->{_tables} = []; for my $table (@tables) { debug(4, " table def [$table]"); if($table =~ /create\s+table/i) { my $obj = MySQL::Diff::Table->new(source => $self->{_source}, def => $table); push @{$self->{_tables}}, $obj; $self->{_by_name}{$obj->name()} = $obj; } } } sub _auth_args_string { my %auth = @_; my $args = []; for my $arg (qw/host port user password socket/) { push @$args, qq/--$arg=$auth{$arg}/ if $auth{$arg}; } return $args; } 1; __END__ =head1 COPYRIGHT AND LICENSE Copyright (c) 2000-2016 Adam Spiers. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L =head1 AUTHOR Adam Spiers =cut 96perl_minimum_version.t100644000000000000 143313305551767 17710 0ustar00rootroot000000000000MySQL-Diff-0.60/xt# -*- perl -*- # Test that our declared minimum Perl version matches our syntax use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'Perl::MinimumVersion 1.20', 'Test::MinimumVersion 0.008', ); # Don't run tests during end-user installs use Test::More; unless (-d '.git' || $ENV{AUTOMATED_TESTING}) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing modules foreach my $MODULE ( @MODULES ) { eval "use $MODULE"; if ( $@ ) { plan( skip_all => "$MODULE not available for testing" ); die "Failed to load required release-testing module $MODULE" if -d '.git' || $ENV{AUTOMATED_TESTING}; } } # false positive use_base_exporter works ok with 5.6.2 all_minimum_version_ok("5.006", {skip => ['lib/MySQL/Diff/Utils.pm']}); 1;