@@ -1,5 +1,21 @@
Changes for SQL::Translator
+0.11020 2014-09-02
+
+ * Fix test failure if Test::PostgreSQL is installed but not working
+
+0.11019 2014-09-02
+
+ * Add Json and hstore types to Pg Parser (cloudinstustrie)
+ * Fix DROP TABLE in SQL Server Producer
+ * Fix Pg DBI parser test (Dagfinn Ilmari Mannsåker)
+ * Remove spurious warnings (Matt Phillips, Wallace Reis)
+ * Fix MySQL producer for columns with scalar ref in 'ON UPDATE' (Wallace Reis)
+ * Fix handling of views in MySQL DBI parser
+ * Fix handling of renamed fields in SQLite diff (Peter Mottram)
+ * Check numeric equality of default values in numeric-type fields (Wallace Reis)
+ * Fix handling of renamed fields in renamed tables in Pg diff (Peter Mottram)
+
0.11018 2013-10-31 🎃
* Revert "Fix AUTOINCREMENT in SQLite"
@@ -219,6 +219,8 @@ t/data/xml/samefield.xml
t/data/xml/schema.xml
t/lib/Producer/BaseTest.pm
t/mysql-sqlite-translate.t
+t/postgresql-rename-table-and-field.t
+t/sqlite-rename-field.t
xt/eol.t
xt/notabs.t
xt/pod.t
@@ -4,17 +4,18 @@ author:
- 'Ken Youens-Clark <kclark@cpan.org>'
build_requires:
ExtUtils::MakeMaker: 6.59
- JSON: 2.0
+ JSON: '2.0'
Test::Differences: 0
- Test::Exception: 0.31
- Test::More: 0.88
- XML::Writer: 0.500
- YAML: 0.66
+ Test::Exception: '0.31'
+ Test::More: '0.88'
+ Text::ParseWords: 0
+ XML::Writer: '0.500'
+ YAML: '0.66'
configure_requires:
ExtUtils::MakeMaker: 6.59
distribution_type: module
dynamic_config: 1
-generated_by: 'Module::Install version 1.06'
+generated_by: 'Module::Install version 1.10'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -30,26 +31,27 @@ recommends:
GD: 0
Graph::Directed: 0
GraphViz: 0
- Spreadsheet::ParseExcel: 0.41
- Template: 2.20
- Text::RecordParser: 0.02
- XML::LibXML: 1.69
+ Spreadsheet::ParseExcel: '0.41'
+ Template: '2.20'
+ Text::RecordParser: '0.02'
+ XML::LibXML: '1.69'
requires:
Carp::Clan: 0
- DBI: 1.54
+ DBI: '1.54'
Digest::SHA: 0
- File::ShareDir: 1.0
- List::MoreUtils: 0.09
- Moo: 1.000003
- Package::Variant: 1.001001
- Parse::RecDescent: 1.967009
+ File::ShareDir: '1.0'
+ List::MoreUtils: '0.09'
+ Moo: '1.000003'
+ Package::Variant: '1.001001'
+ Parse::RecDescent: '1.967009'
+ Scalar::Util: 0
Sub::Quote: 0
- Try::Tiny: 0.04
+ Try::Tiny: '0.04'
perl: 5.8.1
resources:
Ratings: http://cpanratings.perl.org/d/SQL-Translator
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Translator
license: http://dev.perl.org/licenses/
repository: git://git.shadowcat.co.uk/dbsrgits/SQL-Translator.git
-version: 0.11018
+version: '0.11020'
x_authority: cpan:JROBINSON
@@ -19,6 +19,7 @@ my $deps = {
'Sub::Quote' => '0',
'Try::Tiny' => '0.04',
'List::MoreUtils' => '0.09',
+ 'Scalar::Util' => '0',
},
recommends => {
'Template' => '2.20',
@@ -36,6 +37,7 @@ my $deps = {
'Test::More' => '0.88',
'Test::Differences' => '0',
'Test::Exception' => '0.31',
+ 'Text::ParseWords' => '0',
},
};
@@ -190,21 +192,19 @@ sub _recreate_rt_source {
};
if ($@) {
- warn <<EOE;
+ die <<EOE;
=========================================================================
=============== WARNING !!! =================
=========================================================================
Unable to update the roundtrip schema (attempt triggered by AUTHOR mode).
-We will still generate a Makefile, but be aware that if you build a dist
-this way, it *WILL* be broken.
+Aborting Makefile generation, please fix the errors indicated below
+(typically by installing the missing modules).
-------------------------------------------------------------------------
$@
-Press Enter to continue.
EOE
- <>;
}
}
@@ -8,7 +8,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
}
# special map on pre-defined feature sets
@@ -115,7 +115,7 @@ sub import {
print "*** $class version " . $class->VERSION . "\n";
print "*** Checking for Perl dependencies...\n";
- my $cwd = Cwd::cwd();
+ my $cwd = Cwd::getcwd();
$Config = [];
@@ -166,7 +166,7 @@ sub import {
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
unshift @$modules, -default => &{ shift(@$modules) }
- if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
if ( $mod =~ m/^-(\w+)$/ ) {
@@ -345,22 +345,26 @@ sub install {
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
- my ( @modules, @installed );
- while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+ my ( @modules, @installed, @modules_to_upgrade );
+ while (my ($pkg, $ver) = splice(@_, 0, 2)) {
- # grep out those already installed
- if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
- push @installed, $pkg;
- }
- else {
- push @modules, $pkg, $ver;
- }
- }
+ # grep out those already installed
+ if (_version_cmp(_version_of($pkg), $ver) >= 0) {
+ push @installed, $pkg;
+ if ($UpgradeDeps) {
+ push @modules_to_upgrade, $pkg, $ver;
+ }
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
- if ($UpgradeDeps) {
- push @modules, @installed;
- @installed = ();
- }
+ if ($UpgradeDeps) {
+ push @modules, @modules_to_upgrade;
+ @installed = ();
+ @modules_to_upgrade = ();
+ }
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
@@ -611,7 +615,7 @@ sub _under_cpan {
require Cwd;
require File::Spec;
- my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cwd = File::Spec->canonpath( Cwd::getcwd() );
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
return ( index( $cwd, $cpan ) > -1 );
@@ -927,4 +931,4 @@ END_MAKE
__END__
-#line 1193
+#line 1197
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -91,3 +91,7 @@ sub auto_install_now {
}
1;
+
+__END__
+
+#line 109
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
}
# Suspend handler for "redefined" warnings
@@ -8,7 +8,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -91,3 +91,7 @@ END_FTP
}
1;
+
+__END__
+
+#line 109
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -32,3 +32,7 @@ sub auto_include_dependent_dists {
}
1;
+
+__END__
+
+#line 50
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -133,7 +133,7 @@ sub makemaker_args {
return $args;
}
-# For mm args that take multiple space-seperated args,
+# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -347,7 +347,7 @@ sub name_from {
^ \s*
package \s*
([\w:]+)
- \s* ;
+ [\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
@@ -453,24 +453,40 @@ sub author_from {
#Stolen from M::B
my %license_urls = (
- perl => 'http://dev.perl.org/licenses/',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
- artistic => 'http://opensource.org/licenses/artistic-license.php',
- artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
- lgpl => 'http://opensource.org/licenses/lgpl-license.php',
- lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
- lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
- bsd => 'http://opensource.org/licenses/bsd-license.php',
- gpl => 'http://opensource.org/licenses/gpl-license.php',
- gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
- gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
- mit => 'http://opensource.org/licenses/mit-license.php',
- mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
open_source => undef,
unrestricted => undef,
restrictive => undef,
unknown => undef,
+
+## from Software-License - should we be using S-L instead ?
+# duplicates commeted out, see hack above ^^
+# open_source => 'http://www.gnu.org/licenses/agpl-3.0.txt',
+# apache => 'http://www.apache.org/licenses/LICENSE-1.1',
+ apache => 'http://www.apache.org/licenses/LICENSE-2.0.txt',
+ artistic => 'http://www.perlfoundation.org/artistic_license_1_0',
+ artistic_2 => 'http://www.perlfoundation.org/artistic_license_2_0',
+ bsd => 'http://opensource.org/licenses/BSD-3-Clause',
+# unrestricted => 'http://creativecommons.org/publicdomain/zero/1.0/',
+# open_source => 'http://www.freebsd.org/copyright/freebsd-license.html',
+# open_source => 'http://www.gnu.org/licenses/fdl-1.2.txt',
+# open_source => 'http://www.gnu.org/licenses/fdl-1.3.txt',
+# gpl => 'http://www.gnu.org/licenses/old-licenses/gpl-1.0.txt',
+# gpl => 'http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt',
+ gpl => 'http://www.gnu.org/licenses/gpl-3.0.txt',
+# lgpl => 'http://www.gnu.org/licenses/old-licenses/lgpl-2.1.txt',
+ lgpl => 'http://www.gnu.org/licenses/lgpl-3.0.txt',
+ mit => 'http://www.opensource.org/licenses/mit-license.php',
+# mozilla => 'http://www.mozilla.org/MPL/MPL-1.0.txt',
+# mozilla => 'http://www.mozilla.org/MPL/MPL-1.1.txt',
+ mozilla => 'http://www.mozilla.org/MPL/2.0/index.txt',
+# restrictive => '',
+# open_source => 'http://www.openssl.org/source/license.html',
+ perl => 'http://dev.perl.org/licenses/',
+# open_source => 'http://www.opensource.org/licenses/postgresql',
+# open_source => 'http://trolltech.com/products/qt/licenses/licensing/qpl',
+# unrestricted => 'http://h71000.www7.hp.com/doc/83final/BA554_90007/apcs02.html',
+# open_source => 'http://www.openoffice.org/licenses/sissl_license.html',
+# open_source => 'http://www.zlib.net/zlib_license.html',
);
sub license {
@@ -511,31 +527,43 @@ sub __extract_license {
my @phrases = (
'(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
'(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
- 'Artistic and GPL' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'GNU Free Documentation license' => 'unrestricted', 1,
- 'GNU Affero General Public License' => 'open_source', 1,
+
+ # the following are relied on by the test system even if they are wrong :(
'(?:Free)?BSD license' => 'bsd', 1,
'Artistic license 2\.0' => 'artistic_2', 1,
- 'Artistic license' => 'artistic', 1,
- 'Apache (?:Software )?license' => 'apache', 1,
- 'GPL' => 'gpl', 1,
'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
'MIT' => 'mit', 1,
- 'Mozilla Public License' => 'mozilla', 1,
- 'Q Public License' => 'open_source', 1,
- 'OpenSSL License' => 'unrestricted', 1,
- 'SSLeay License' => 'unrestricted', 1,
- 'zlib License' => 'open_source', 1,
- 'proprietary' => 'proprietary', 0,
+
+## from Software-License
+ 'The GNU Affero General Public License, Version 3, November 2007' => 'open_source', 1,
+ 'The Apache Software License, Version 1.1' => 'apache', 1,
+ 'The Apache License, Version 2.0, January 2004' => 'apache', 1,
+ 'The Artistic License 1.0' => 'artistic', 1,
+ 'The Artistic License 2.0 (GPL Compatible)' => 'artistic_2', 1,
+ 'The (three-clause) BSD License' => 'bsd', 1,
+ 'CC0 License' => 'unrestricted', 1,
+ 'The (two-clause) FreeBSD License' => 'open_source', 1,
+ 'GNU Free Documentation License v1.2' => 'open_source', 1,
+ 'GNU Free Documentation License v1.3' => 'open_source', 1,
+ 'The GNU General Public License, Version 1, February 1989' => 'gpl', 1,
+ 'The GNU General Public License, Version 2, June 1991' => 'gpl', 1,
+ 'The GNU General Public License, Version 3, June 2007' => 'gpl', 1,
+ 'The GNU Lesser General Public License, Version 2.1, February 1999' => 'lgpl', 1,
+ 'The GNU Lesser General Public License, Version 3, June 2007' => 'lgpl', 1,
+ 'The MIT (X11) License' => 'mit', 1,
+ 'The Mozilla Public License 1.0' => 'mozilla', 1,
+ 'The Mozilla Public License 1.1' => 'mozilla', 1,
+ 'Mozilla Public License Version 2.0' => 'mozilla', 1,
+ '"No License" License' => 'restrictive', 1,
+ 'OpenSSL License' => 'open_source', 1,
+ 'the same terms as the perl 5 programming language system itself' => 'perl', 1,
+ 'The PostgreSQL License' => 'open_source', 1,
+ 'The Q Public License, Version 1.0' => 'open_source', 1,
+ 'Original SSLeay License' => 'unrestricted', 1,
+ 'Sun Internet Standards Source License (SISSL)' => 'open_source', 1,
+ 'The zlib License' => 'open_source', 1,
);
+
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
@@ -705,7 +733,7 @@ sub _write_mymeta_data {
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
- # Overwrite the non-configure dependency hashs
+ # Overwrite the non-configure dependency hashes
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
@@ -720,3 +748,7 @@ sub _write_mymeta_data {
}
1;
+
+__END__
+
+#line 766
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -27,3 +27,7 @@ sub install_script {
}
1;
+
+__END__
+
+#line 45
@@ -8,7 +8,7 @@ use ExtUtils::Manifest ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -62,3 +62,7 @@ END_MESSAGE
}
1;
+
+__END__
+
+#line 80
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.10';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -61,3 +61,7 @@ sub WriteAll {
}
1;
+
+__END__
+
+#line 79
@@ -17,7 +17,7 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-use 5.005;
+use 5.006;
use strict 'vars';
use Cwd ();
use File::Find ();
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.06';
+ $VERSION = '1.10';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -156,10 +156,10 @@ END_DIE
sub autoload {
my $self = shift;
my $who = $self->_caller;
- my $cwd = Cwd::cwd();
+ my $cwd = Cwd::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
+ my $pwd = Cwd::getcwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
@@ -239,7 +239,7 @@ sub new {
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
@@ -338,7 +338,7 @@ sub find_extensions {
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
- foreach ( split //, $content ) {
+ foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
@@ -434,7 +434,7 @@ END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
-sub _version ($) {
+sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
@@ -450,12 +450,12 @@ sub _version ($) {
return $l + 0;
}
-sub _cmp ($$) {
+sub _cmp {
_version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
-sub _CLASS ($) {
+sub _CLASS {
(
defined $_[0]
and
@@ -467,4 +467,7 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2012 Adam Kennedy.
+
+__END__
+
+#line 485
@@ -520,6 +520,11 @@ supports the ability to do all alters for a table as one statement.
If the diff would need a method that is missing from the producer, just emit a
comment showing the method is missing, rather than dieing with an error
+=item B<producer_args>
+
+Hash of extra arguments passed to L<SQL::Translator/new> and the below
+L</PRODUCER FUNCTIONS>.
+
=back
=head1 PRODUCER FUNCTIONS
@@ -530,34 +535,35 @@ thrown.
=over
-=item * C<alter_create_constraint($con)>
+=item * C<alter_create_constraint($con, $args)>
-=item * C<alter_drop_constraint($con)>
+=item * C<alter_drop_constraint($con, $args)>
-=item * C<alter_create_index($idx)>
+=item * C<alter_create_index($idx, $args)>
-=item * C<alter_drop_index($idx)>
+=item * C<alter_drop_index($idx, $args)>
-=item * C<add_field($fld)>
+=item * C<add_field($fld, $args)>
-=item * C<alter_field($old_fld, $new_fld)>
+=item * C<alter_field($old_fld, $new_fld, $args)>
-=item * C<rename_field($old_fld, $new_fld)>
+=item * C<rename_field($old_fld, $new_fld, $args)>
-=item * C<drop_field($fld)>
+=item * C<drop_field($fld, $args)>
-=item * C<alter_table($table)>
+=item * C<alter_table($table, $args)>
-=item * C<drop_table($table)>
+=item * C<drop_table($table, $args)>
-=item * C<rename_table($old_table, $new_table)> (optional)
+=item * C<rename_table($old_table, $new_table, $args)> (optional)
-=item * C<batch_alter_table($table, $hash)> (optional)
+=item * C<batch_alter_table($table, $hash, $args)> (optional)
If the producer supports C<batch_alter_table>, it will be called with the
table to alter and a hash, the keys of which will be the method names listed
above; values will be arrays of fields or constraints to operate on. In the
-case of the field functions that take two arguments this will appear as a hash.
+case of the field functions that take two arguments this will appear as an
+array reference.
I.e. the hash might look something like the following:
@@ -568,7 +574,7 @@ I.e. the hash might look something like the following:
}
-=item * C<preprocess_schema($class, $schema)> (optional)
+=item * C<preprocess_schema($schema)> (optional)
C<preprocess_schema> is called by the Diff code to allow the producer to
normalize any data it needs to first. For example, the MySQL producer uses
@@ -198,7 +198,7 @@ sub remove_table_constraints {
}
sub drop_tables {
- my ($self, $schema) = shift;
+ my ($self, $schema) = @_;
if ($self->add_drop_table) {
my @tables = sort { $b->order <=> $a->order } $schema->get_tables;
@@ -37,13 +37,13 @@ sub parse {
$dbh->{'FetchHashKeyName'} = 'NAME_lc';
- my $create;
+ my $create = q{};
for my $table_name ( @table_names ) {
next if (grep /^$table_name$/, @skip_tables);
my $sth = $dbh->prepare("show create table $table_name");
$sth->execute;
my $table = $sth->fetchrow_hashref;
- $create .= $table->{'create table'} . ";\n\n";
+ $create .= ($table->{'create table'} || $table->{'create view'}) . ";\n\n";
}
SQL::Translator::Parser::MySQL::parse( $tr, $create );
@@ -639,7 +639,7 @@ pg_data_type :
};
}
|
- /(bit|box|cidr|circle|date|inet|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|timetz|time|varchar)/i
+ /(bit|box|cidr|circle|date|inet|line|lseg|macaddr|money|numeric|decimal|path|point|polygon|timetz|time|varchar|json|hstore)/i
{
$return = { type => $item[1] };
}
@@ -93,7 +93,9 @@ my $DEFAULT_MAX_ID_LENGTH = 64;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug header_comment
- truncate_id_uniquely parse_mysql_version);
+ truncate_id_uniquely parse_mysql_version
+ batch_alter_table_statements
+);
#
# Use only lowercase for the keys (e.g. "long" and not "LONG")
@@ -606,7 +608,12 @@ sub create_field
}
for my $qual ( 'character set', 'collate', 'on update' ) {
my $val = $extra{ $qual } || $extra{ uc $qual } or next;
- $field_def .= " $qual $val";
+ if ( ref $val ) {
+ $field_def .= " $qual ${$val}";
+ }
+ else {
+ $field_def .= " $qual $val";
+ }
}
# Null?
@@ -904,21 +911,7 @@ sub batch_alter_table {
}
- my @stmts = map {
- if (@{ $diff_hash->{$_} || [] }) {
- my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
- map { $meth->( (ref $_ eq 'ARRAY' ? @$_ : $_), $options ) } @{ $diff_hash->{$_} }
- } else { () }
- } qw/rename_table
- alter_drop_constraint
- alter_drop_index
- drop_field
- add_field
- alter_field
- rename_field
- alter_create_index
- alter_create_constraint
- alter_table/;
+ my @stmts = batch_alter_table_statements($diff_hash, $options);
#quote
my $qt = $options->{quote_table_names} || '';
@@ -27,7 +27,7 @@ $DEBUG = 0 unless defined $DEBUG;
use base qw(SQL::Translator::Producer);
use SQL::Translator::Schema::Constants;
-use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
+use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements);
use SQL::Translator::Generator::DDL::PostgreSQL;
use Data::Dumper;
@@ -1019,6 +1019,47 @@ sub drop_table {
return $out;
}
+sub batch_alter_table {
+ my ( $table, $diff_hash, $options ) = @_;
+ my $qt = $options->{quote_table_names} || '';
+ $generator->quote_chars([$qt]);
+
+ # as long as we're not renaming the table we don't need to be here
+ if ( @{$diff_hash->{rename_table}} == 0 ) {
+ return batch_alter_table_statements($diff_hash, $options);
+ }
+
+ # first we need to perform drops which are on old table
+ my @sql = batch_alter_table_statements($diff_hash, $options, qw(
+ alter_drop_constraint
+ alter_drop_index
+ drop_field
+ ));
+
+ # next comes the rename_table
+ my $old_table = $diff_hash->{rename_table}[0][0];
+ push @sql, rename_table( $old_table, $table, $options );
+
+ # for alter_field (and so also rename_field) we need to make sure old
+ # field has table name set to new table otherwise calling alter_field dies
+ $diff_hash->{alter_field} =
+ [map { $_->[0]->table($table) && $_ } @{$diff_hash->{alter_field}}];
+ $diff_hash->{rename_field} =
+ [map { $_->[0]->table($table) && $_ } @{$diff_hash->{rename_field}}];
+
+ # now add everything else
+ push @sql, batch_alter_table_statements($diff_hash, $options, qw(
+ add_field
+ alter_field
+ rename_field
+ alter_create_index
+ alter_create_constraint
+ alter_table
+ ));
+
+ return @sql;
+}
+
1;
# -------------------------------------------------------------------
@@ -14,7 +14,7 @@ sub produce {
my $translator = shift;
SQL::Translator::Generator::DDL::SQLServer->new(
add_comments => !$translator->no_comments,
- add_drop_tables => $translator->add_drop_table,
+ add_drop_table => $translator->add_drop_table,
)->schema($translator->schema)
}
@@ -21,7 +21,7 @@ use strict;
use warnings;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
-use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
+use SQL::Translator::Utils qw(debug header_comment parse_dbms_version batch_alter_table_statements);
use SQL::Translator::Generator::DDL::SQLite;
our ( $DEBUG, $WARN );
@@ -406,7 +406,7 @@ sub alter_drop_index {
}
sub batch_alter_table {
- my ($table, $diffs) = @_;
+ my ($table, $diffs, $options) = @_;
# If we have any of the following
#
@@ -428,42 +428,38 @@ sub batch_alter_table {
# Fun, eh?
#
# If we have rename_field we do similarly.
+ #
+ # We create the temporary table as a copy of the new table, copy all data
+ # to temp table, create new table and then copy as appropriate taking note
+ # of renamed fields.
my $table_name = $table->name;
- my $renaming = $diffs->{rename_table} && @{$diffs->{rename_table}};
if ( @{$diffs->{rename_field}} == 0 &&
@{$diffs->{alter_field}} == 0 &&
@{$diffs->{drop_field}} == 0
) {
-# return join("\n", map {
- return map {
- my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
- map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ? ("$sql") : () } @{ $diffs->{$_} }
-
- } grep { @{$diffs->{$_}} }
- qw/rename_table
- alter_drop_constraint
- alter_drop_index
- drop_field
- add_field
- alter_field
- rename_field
- alter_create_index
- alter_create_constraint
- alter_table/;
+ return batch_alter_table_statements($diffs, $options);
}
my @sql;
- my $old_table = $renaming ? $diffs->{rename_table}[0][0] : $table;
- if(@{$diffs->{drop_field}}) {
- $old_table =$diffs->{drop_field}[0]->table;
+ # $table is the new table but we may need an old one
+ # TODO: this is NOT very well tested at the moment so add more tests
+
+ my $old_table = $table;
+
+ if ( $diffs->{rename_table} && @{$diffs->{rename_table}} ) {
+ $old_table = $diffs->{rename_table}[0][0];
}
+ my $temp_table_name = $table_name . '_temp_alter';
+
+ # CREATE TEMPORARY TABLE t1_backup(a,b);
+
my %temp_table_fields;
do {
- local $table->{name} = $table_name . '_temp_alter';
+ local $table->{name} = $temp_table_name;
# We only want the table - don't care about indexes on tmp table
my ($table_sql) = create_table($table, {no_comments => 1, temporary_table => 1});
push @sql,$table_sql;
@@ -471,13 +467,51 @@ sub batch_alter_table {
%temp_table_fields = map { $_ => 1} $table->get_fields;
};
- push @sql, "INSERT INTO @{[_generator()->quote($table_name.'_temp_alter')]}( @{[ join(', ', map _generator()->quote($_), grep { $temp_table_fields{$_} } $old_table->get_fields)]}) SELECT @{[ join(', ', map _generator()->quote($_), grep { $temp_table_fields{$_} } $old_table->get_fields)]} FROM @{[_generator()->quote($old_table)]}",
- "DROP TABLE @{[_generator()->quote($old_table)]}",
- create_table($table, { no_comments => 1 }),
- "INSERT INTO @{[_generator()->quote($table_name)]} SELECT @{[ join(', ', map _generator()->quote($_), $table->get_fields)]} FROM @{[_generator()->quote($table_name.'_temp_alter')]}",
- "DROP TABLE @{[_generator()->quote($table_name.'_temp_alter')]}";
- return @sql;
-# return join("", @sql, "");
+ # record renamed fields for later
+ my %rename_field = map { $_->[1]->name => $_->[0]->name } @{$diffs->{rename_field}};
+
+ # drop added fields from %temp_table_fields
+ delete @temp_table_fields{@{$diffs->{add_field}}};
+
+ # INSERT INTO t1_backup SELECT a,b FROM t1;
+
+ push @sql, sprintf( 'INSERT INTO %s( %s) SELECT %s FROM %s',
+
+ _generator()->quote( $temp_table_name ),
+
+ join( ', ',
+ map _generator()->quote($_),
+ grep { $temp_table_fields{$_} } $table->get_fields ),
+
+ join( ', ',
+ map _generator()->quote($_),
+ map { $rename_field{$_} ? $rename_field{$_} : $_ }
+ grep { $temp_table_fields{$_} } $table->get_fields ),
+
+ _generator()->quote( $old_table->name )
+ );
+
+ # DROP TABLE t1;
+
+ push @sql, sprintf('DROP TABLE %s', _generator()->quote($old_table->name));
+
+ # CREATE TABLE t1(a,b);
+
+ push @sql, create_table($table, { no_comments => 1 });
+
+ # INSERT INTO t1 SELECT a,b FROM t1_backup;
+
+ push @sql, sprintf('INSERT INTO %s SELECT %s FROM %s',
+ _generator()->quote($table_name),
+ join(', ', map _generator()->quote($_), $table->get_fields),
+ _generator()->quote($temp_table_name)
+ );
+
+ # DROP TABLE t1_backup;
+
+ push @sql, sprintf('DROP TABLE %s', _generator()->quote($temp_table_name));
+
+ return wantarray ? @sql : join(";\n", @sql);
}
sub drop_table {
@@ -196,9 +196,9 @@ Returns undef or an empty list if the constraint has no fields set.
sub fields {
my $self = shift;
my $table = $self->table;
- my @tables = map { $table->get_field($_) || $_ } @{$self->field_names(@_) || []};
- return wantarray ? @tables
- : @tables ? \@tables
+ my @fields = map { $table->get_field($_) || $_ } @{$self->field_names(@_) || []};
+ return wantarray ? @fields
+ : @fields ? \@fields
: undef;
}
@@ -27,6 +27,7 @@ use SQL::Translator::Schema::Constants;
use SQL::Translator::Types qw(schema_obj);
use SQL::Translator::Utils qw(parse_list_arg ex2err throw carp_ro);
use Sub::Quote qw(quote_sub);
+use Scalar::Util ();
extends 'SQL::Translator::Schema::Object';
@@ -53,10 +54,14 @@ our %type_mapping = (
bigint => SQL_BIGINT,
double => SQL_DOUBLE,
+ 'double precision' => SQL_DOUBLE,
decimal => SQL_DECIMAL,
- numeric => SQL_NUMERIC,
dec => SQL_DECIMAL,
+ numeric => SQL_NUMERIC,
+
+ real => SQL_REAL,
+ float => SQL_FLOAT,
bit => SQL_BIT,
@@ -75,6 +80,16 @@ our %type_mapping = (
);
+has _numeric_sql_data_types => ( is => 'lazy' );
+
+sub _build__numeric_sql_data_types {
+ return {
+ map { $_ => 1 }
+ (SQL_INTEGER, SQL_TINYINT, SQL_SMALLINT, SQL_BIGINT, SQL_DOUBLE,
+ SQL_NUMERIC, SQL_DECIMAL, SQL_FLOAT, SQL_REAL)
+ };
+}
+
=head2 new
Object constructor.
@@ -543,7 +558,14 @@ around equals => sub {
my $effective_lhs = $lhs_is_ref ? $$lhs : $lhs;
my $effective_rhs = $rhs_is_ref ? $$rhs : $rhs;
- return 0 if $effective_lhs ne $effective_rhs;
+ if ( $self->_is_numeric_data_type
+ && Scalar::Util::looks_like_number($effective_lhs)
+ && Scalar::Util::looks_like_number($effective_rhs) ) {
+ return 0 if ($effective_lhs + 0) != ($effective_rhs + 0);
+ }
+ else {
+ return 0 if $effective_lhs ne $effective_rhs;
+ }
}
return 0 unless $self->is_nullable eq $other->is_nullable;
@@ -559,6 +581,11 @@ around equals => sub {
# Must come after all 'has' declarations
around new => \&ex2err;
+sub _is_numeric_data_type {
+ my $self = shift;
+ return $self->_numeric_sql_data_types->{ $self->sql_data_type };
+}
+
1;
=pod
@@ -15,7 +15,7 @@ use base qw(Exporter);
our @EXPORT_OK = qw(
debug normalize_name header_comment parse_list_arg truncate_id_uniquely
$DEFAULT_COMMENT parse_mysql_version parse_dbms_version
- ddl_parser_instance
+ ddl_parser_instance batch_alter_table_statements
throw ex2err carp_ro
);
use constant COLLISION_TAG_LENGTH => 8;
@@ -220,7 +220,8 @@ sub ddl_parser_instance {
});
# this is disabled until RT#74593 is resolved
-=begin for general sadness
+
+=begin sadness
unless ($parsers_libdir) {
@@ -280,6 +281,9 @@ sub ddl_parser_instance {
}
return $precompiled_mod->new;
+
+=end sadness
+
=cut
}
@@ -344,6 +348,31 @@ sub carp_ro {
};
}
+sub batch_alter_table_statements {
+ my ($diff_hash, $options, @meths) = @_;
+
+ @meths = qw(
+ rename_table
+ alter_drop_constraint
+ alter_drop_index
+ drop_field
+ add_field
+ alter_field
+ rename_field
+ alter_create_index
+ alter_create_constraint
+ alter_table
+ ) unless @meths;
+
+ my $package = caller;
+
+ return map {
+ my $meth = $package->can($_) or die "$package cant $_";
+ map { $meth->(ref $_ eq 'ARRAY' ? @$_ : $_, $options) } @{ $diff_hash->{$_} }
+ } grep { @{$diff_hash->{$_} || []} }
+ @meths;
+}
+
1;
=pod
@@ -519,6 +548,43 @@ Takes a field name and returns a reference to a function can be used
L<around|Moo/around> a read-only accessor to make it L<carp|Carp/carp>
instead of die when passed an argument.
+=head2 batch_alter_table_statements
+
+Takes diff and argument hashes as passed to
+L<batch_alter_table|SQL::Translator::Diff/batch_alter_table($table, $hash) (optional)>
+and an optional list of producer functions to call on the calling package.
+Returns the list of statements returned by the producer functions.
+
+If no producer functions are specified, the following functions in the
+calling package are called:
+
+=over
+
+=item 1. rename_table
+
+=item 2. alter_drop_constraint
+
+=item 3. alter_drop_index
+
+=item 4. drop_field
+
+=item 5. add_field
+
+=item 5. alter_field
+
+=item 6. rename_field
+
+=item 7. alter_create_index
+
+=item 8. alter_create_constraint
+
+=item 9. alter_table
+
+=back
+
+If the corresponding array in the hash has any elements, but the
+caller doesn't implement that function, an exception is thrown.
+
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
@@ -3,7 +3,7 @@ package SQL::Translator;
use Moo;
our ( $DEFAULT_SUB, $DEBUG, $ERROR );
-our $VERSION = '0.11018';
+our $VERSION = '0.11020';
$DEBUG = 0 unless defined $DEBUG;
$ERROR = "";
@@ -467,7 +467,9 @@ sub maybe_plan {
join ", ", @errors;
plan skip_all => $msg;
}
- elsif ($ntests and $ntests ne 'no_plan') {
+ return unless defined $ntests;
+
+ if ($ntests ne 'no_plan') {
plan tests => $ntests;
}
else {
@@ -582,6 +584,9 @@ modules on which test execution depends:
If one of C<SQL::Translator::Parser::MySQL>'s dependencies does not exist,
then the test will be skipped.
+Instead of a number of tests, you can pass C<undef> if you're using
+C<done_testing()>, or C<'no_plan'> if you don't want a plan at all.
+
=head1 EXPORTS
table_ok, field_ok, constraint_ok, index_ok, view_ok, trigger_ok, procedure_ok,
@@ -143,14 +143,6 @@ for my $arg ( @ARGV ) {
}
}
-print STDERR <<'EOM' unless $ENV{SQLT_NEWDIFF_NOWARN};
-This code is experimental, currently the new code only supports MySQL or
-SQLite diffing. To add support for other databases, please patch the relevant
-SQL::Translator::Producer:: module. If you need compatibility with the old
-sqlt-diff, please use sqlt-diff-old, and look into helping us make this one
-work for you
-EOM
-
my $tr = SQL::Translator->new;
my @parsers = $tr->list_parsers;
my %valid_parsers = map { $_, 1 } @parsers;
@@ -6,6 +6,7 @@ use File::Temp qw(mktemp);
use FindBin qw($Bin);
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
+use Text::ParseWords qw(shellwords);
BEGIN {
maybe_plan(
@@ -17,7 +18,7 @@ BEGIN {
}
my @script = qw(script sqlt-diagram);
-my @data = qw(data mysql Apache-Session-MySQL.sql);
+my @data = qw(data mysql create2.sql);
my $sqlt_diagram = catfile($Bin, updir, @script);
my $test_data = catfile($Bin, @data);
@@ -25,7 +26,7 @@ my $test_data = catfile($Bin, @data);
my $tmp = mktemp('sqlXXXXX');
ok(-e $sqlt_diagram);
-my @cmd = ($^X, $sqlt_diagram, "-d", "MySQL", "-o", $tmp, $test_data);
+my @cmd = ($^X, shellwords($ENV{HARNESS_PERL_SWITCHES}), $sqlt_diagram, "-d", "MySQL", "-o", $tmp, $test_data);
eval { system(@cmd); };
ok(!$@ && ($? == 0));
ok(-e $tmp);
@@ -4,7 +4,8 @@
$| = 1;
use strict;
-use Test::More tests => 245;
+use warnings;
+use Test::More;
use Test::Exception;
use SQL::Translator::Schema::Constants;
@@ -168,6 +169,8 @@ require_ok( 'SQL::Translator::Schema' );
is( join(",",$person_table->field_names), 'foo,f2',
'field_names is "foo,f2"' );
+ my $ci_field = $person_table->get_field('FOO', 'case_insensitive');
+ is( $ci_field->name, 'foo', 'Got field case-insensitively' );
#
# $table-> drop_field
#
@@ -744,3 +747,80 @@ require_ok( 'SQL::Translator::Schema' );
throws_ok { $f1 = $t2->add_field( name => 'location' ) }
qr/field order incomplete/;
}
+
+#
+# Test link tables
+#
+
+{
+ my $s = SQL::Translator::Schema->new;
+ my $t1 = $s->add_table( name => 'person' );
+ $t1->add_field( name => 'id' );
+ $t1->primary_key( 'id' );
+ $t1->add_field( name => 'name' );
+
+ ok( $t1->is_data, 'Person table has data' );
+ ok( !$t1->is_trivial_link, 'Person table is not trivial' );
+
+ my $t2 = $s->add_table( name => 'pet' );
+ $t2->add_field( name => 'id' );
+ $t2->primary_key( 'id' );
+ $t2->add_field( name => 'name' );
+
+ ok( $t2->is_data, 'Pet table has data' );
+ ok( !$t1->is_trivial_link, 'Pet table is trivial' );
+
+ my $t3 = $s->add_table( name => 'person_pet' );
+ $t3->add_field( name => 'id' );
+ my $f1 = $t3->add_field( name => 'person_id' );
+ my $f2 = $t3->add_field( name => 'pet_id' );
+ $t3->primary_key( 'id' );
+
+ $t3->add_constraint(
+ type => FOREIGN_KEY,
+ fields => 'person_id',
+ reference_table => $t1,
+ );
+
+ $t3->add_constraint(
+ type => FOREIGN_KEY,
+ fields => 'pet_id',
+ reference_table => $t2,
+ );
+
+ ok( $f1->is_foreign_key, "person_id is foreign key" );
+ ok( $f2->is_foreign_key, "pet_id is foreign key" );
+
+ ok( !$t3->is_data, 'Link table has no data' );
+ ok( $t3->is_trivial_link, 'Link table is trivial' );
+ is( $t3->can_link($t1, $t2)->[0], 'one2one', 'Link table can link' );
+
+ my $t4 = $s->add_table( name => 'fans' );
+ my $f3 = $t4->add_field( name => 'fan_id' );
+ my $f4 = $t4->add_field( name => 'idol_id' );
+ $t4->primary_key( 'fan_id', 'idol_id' );
+
+ $t4->add_constraint(
+ type => FOREIGN_KEY,
+ name => 'fan_fan_fk',
+ fields => 'fan_id',
+ reference_table => $t1,
+ );
+
+ $t4->add_constraint(
+ type => FOREIGN_KEY,
+ name => 'fan_idol_fk',
+ fields => 'idol_id',
+ reference_table => $t1,
+ );
+
+ ok( $f3->is_foreign_key, "fan_id is foreign key" );
+ ok( $f4->is_foreign_key, "idol_id is foreign key" );
+
+ ok( !$t4->is_data, 'Self-link table has no data' );
+ ok( !$t4->is_trivial_link, 'Self-link table is not trivial' );
+ is( $t4->can_link($t1, $t1)->[0], 'many2many', 'Self-link table can link' );
+ ok( !$t4->can_link($t1, $t2)->[0], 'Self-link table can\'t link other' );
+}
+
+done_testing;
@@ -8,7 +8,7 @@ use SQL::Translator::Schema::Constants;
use Test::SQL::Translator qw(maybe_plan);
BEGIN {
- maybe_plan(140, 'SQL::Translator::Parser::PostgreSQL');
+ maybe_plan(154, 'SQL::Translator::Parser::PostgreSQL');
SQL::Translator::Parser::PostgreSQL->import('parse');
}
@@ -29,7 +29,9 @@ my $sql = q{
f_fk1 integer not null references t_test2 (f_id),
f_dropped text,
f_timestamp timestamp(0) with time zone,
- f_timestamp2 timestamp without time zone
+ f_timestamp2 timestamp without time zone,
+ f_json json,
+ f_hstore hstore
);
create table t_test2 (
@@ -117,7 +119,7 @@ is( $t1->name, 't_test1', 'Table t_test1 exists' );
is( $t1->comments, 'comment on t_test1', 'Table comment exists' );
my @t1_fields = $t1->get_fields;
-is( scalar @t1_fields, 13, '13 fields in t_test1' );
+is( scalar @t1_fields, 15, '15 fields in t_test1' );
my $f1 = shift @t1_fields;
is( $f1->name, 'f_serial', 'First field is "f_serial"' );
@@ -224,6 +226,24 @@ is( $f12->default_value, undef, 'Default value is "undef"' );
is( $f12->is_primary_key, 0, 'Field is not PK' );
is( $f12->is_foreign_key, 0, 'Field is not FK' );
+my $f13 = shift @t1_fields;
+is( $f13->name, 'f_json', '13th field is "f_json"' );
+is( $f13->data_type, 'json', 'Field is Json' );
+is( $f13->is_nullable, 1, 'Field can be null' );
+is( $f13->size, 0, 'Size is "0"' );
+is( $f13->default_value, undef, 'Default value is "undef"' );
+is( $f13->is_primary_key, 0, 'Field is not PK' );
+is( $f13->is_foreign_key, 0, 'Field is not FK' );
+
+my $f14 = shift @t1_fields;
+is( $f14->name, 'f_hstore', '14th field is "f_hstore"' );
+is( $f14->data_type, 'hstore', 'Field is hstore' );
+is( $f14->is_nullable, 1, 'Field can be null' );
+is( $f14->size, 0, 'Size is "0"' );
+is( $f14->default_value, undef, 'Default value is "undef"' );
+is( $f14->is_primary_key, 0, 'Field is not PK' );
+is( $f14->is_foreign_key, 0, 'Field is not FK' );
+
# my $fk_ref2 = $f11->foreign_key_reference;
# isa_ok( $fk_ref2, 'SQL::Translator::Schema::Constraint', 'FK' );
# is( $fk_ref2->reference_table, 't_test2', 'FK is to "t_test2" table' );
@@ -199,6 +199,7 @@ ALTER TABLE employee DROP FOREIGN KEY FK5302D47D93FE702E,
ALTER TABLE person DROP INDEX UC_age_name,
DROP INDEX u_name,
ADD COLUMN is_rock_star tinyint(4) NULL DEFAULT 1,
+ ADD COLUMN value double(8, 2) NULL DEFAULT 0.00,
CHANGE COLUMN person_id person_id integer(11) NOT NULL auto_increment,
CHANGE COLUMN name name varchar(20) NOT NULL,
CHANGE COLUMN age age integer(11) NULL DEFAULT 18,
@@ -55,18 +55,21 @@ CREATE TABLE added (
id bigint
);
-ALTER TABLE old_name RENAME TO new_name;
-
ALTER TABLE employee DROP CONSTRAINT FK5302D47D93FE702E;
-ALTER TABLE person DROP CONSTRAINT UC_age_name;
+ALTER TABLE employee DROP COLUMN job_title;
-DROP INDEX u_name;
+ALTER TABLE employee ADD CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id)
+ REFERENCES person (person_id) DEFERRABLE;
-ALTER TABLE employee DROP COLUMN job_title;
+ALTER TABLE old_name RENAME TO new_name;
ALTER TABLE new_name ADD COLUMN new_field integer;
+ALTER TABLE person DROP CONSTRAINT UC_age_name;
+
+DROP INDEX u_name;
+
ALTER TABLE person ADD COLUMN is_rock_star smallint DEFAULT 1;
ALTER TABLE person ALTER COLUMN person_id TYPE serial;
@@ -85,9 +88,6 @@ ALTER TABLE person RENAME COLUMN description TO physical_description;
ALTER TABLE person ADD CONSTRAINT unique_name UNIQUE (name);
-ALTER TABLE employee ADD CONSTRAINT FK5302D47D93FE702E_diff FOREIGN KEY (employee_id)
- REFERENCES person (person_id) DEFERRABLE;
-
ALTER TABLE person ADD CONSTRAINT UC_person_id UNIQUE (person_id);
ALTER TABLE person ADD CONSTRAINT UC_age_name UNIQUE (age, name);
@@ -118,14 +118,14 @@ CREATE TABLE added (
id bigint
);
-ALTER TABLE old_name RENAME TO new_name;
-
-ALTER TABLE person DROP CONSTRAINT UC_age_name;
-
ALTER TABLE employee DROP COLUMN job_title;
+ALTER TABLE old_name RENAME TO new_name;
+
ALTER TABLE new_name ADD COLUMN new_field integer;
+ALTER TABLE person DROP CONSTRAINT UC_age_name;
+
ALTER TABLE person ADD COLUMN is_rock_star smallint DEFAULT 1;
ALTER TABLE person ALTER COLUMN person_id TYPE serial;
@@ -128,10 +128,11 @@ CREATE TEMPORARY TABLE person_temp_alter (
weight double(11,2),
iq int(11) DEFAULT 0,
is_rock_star tinyint(4) DEFAULT 1,
+ value double(8,2) DEFAULT 0.00,
physical_description text
);
-INSERT INTO person_temp_alter( person_id, name, age, weight, iq, is_rock_star, physical_description) SELECT person_id, name, age, weight, iq, is_rock_star, physical_description FROM person;
+INSERT INTO person_temp_alter( person_id, name, age, weight, iq, value, physical_description) SELECT person_id, name, age, weight, iq, value, description FROM person;
DROP TABLE person;
@@ -142,6 +143,7 @@ CREATE TABLE person (
weight double(11,2),
iq int(11) DEFAULT 0,
is_rock_star tinyint(4) DEFAULT 1,
+ value double(8,2) DEFAULT 0.00,
physical_description text
);
@@ -151,7 +153,7 @@ CREATE UNIQUE INDEX UC_person_id02 ON person (person_id);
CREATE UNIQUE INDEX UC_age_name02 ON person (age, name);
-INSERT INTO person SELECT person_id, name, age, weight, iq, is_rock_star, physical_description FROM person_temp_alter;
+INSERT INTO person SELECT person_id, name, age, weight, iq, is_rock_star, value, physical_description FROM person_temp_alter;
DROP TABLE person_temp_alter;
@@ -10,6 +10,7 @@ use SQL::Translator;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
use Symbol qw(gensym);
+use Text::ParseWords qw(shellwords);
BEGIN {
maybe_plan(
@@ -51,7 +52,7 @@ print $fh $output;
close $fh or die "Can't close file '$filename': $!";
my $out;
-my $pid = open3( undef, $out, undef, $^X, '-cw', $filename );
+my $pid = open3( undef, $out, undef, $^X, shellwords($ENV{HARNESS_PERL_SWITCHES}), '-cw', $filename );
my $res = do { local $/; <$out> };
waitpid($pid, 0);
@@ -67,6 +67,20 @@ schema:
mysql_charset: utf8
mysql_collate: utf8_general_ci
order: 4
+ timestamp:
+ data_type: timestamp
+ default_value: !!perl/ref
+ =: CURRENT_TIMESTAMP
+ extra:
+ on update: !!perl/ref
+ =: CURRENT_TIMESTAMP
+ is_nullable: 1
+ is_primary_key: 0
+ is_unique: 0
+ name: timestamp
+ order: 5
+ size:
+ - 0
constraints:
- type: UNIQUE
fields:
@@ -191,6 +205,7 @@ my @stmts = (
`name` varchar(32) NULL,
`swedish_name` varchar(32) character set swe7 NULL,
`description` text character set utf8 collate utf8_general_ci NULL,
+ `timestamp` timestamp on update CURRENT_TIMESTAMP NULL DEFAULT CURRENT_TIMESTAMP,
PRIMARY KEY (`id`),
UNIQUE `idx_unique_name` (`name`)
) ENGINE=InnoDB DEFAULT CHARACTER SET latin1 COLLATE latin1_danish_ci",
@@ -7,30 +7,24 @@ use SQL::Translator;
use SQL::Translator::Schema::Constants;
use Test::SQL::Translator qw(maybe_plan table_ok);
-BEGIN {
- maybe_plan(61, 'SQL::Translator::Parser::DBI::PostgreSQL');
- SQL::Translator::Parser::DBI::PostgreSQL->import('parse');
-}
-
-use_ok('SQL::Translator::Parser::DBI::PostgreSQL');
+maybe_plan(undef, 'SQL::Translator::Parser::DBI::PostgreSQL');
my @dsn =
$ENV{DBICTEST_PG_DSN} ? @ENV{ map { "DBICTEST_PG_$_" } qw/DSN USER PASS/ }
: $ENV{DBI_DSN} ? @ENV{ map { "DBI_$_" } qw/DSN USER PASS/ }
-: ( "dbi:Pg:dbname=postgres", '', '' );
+: plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test';
my $dbh = eval {
DBI->connect(@dsn, {AutoCommit => 1, RaiseError=>1,PrintError => 1} );
};
-SKIP: {
- if (my $err = ($@ || $DBI::err )) {
- chomp $err;
- skip "No connection to test db. DBI says '$err'", 60;
- }
+if (my $err = ($@ || $DBI::err )) {
+ chomp $err;
+ plan skip_all => "No connection to test db. DBI says '$err'";
+}
- ok($dbh, "dbh setup correctly");
- $dbh->do('SET client_min_messages=WARNING');
+ok($dbh, "dbh setup correctly");
+$dbh->do('SET client_min_messages=WARNING');
my $sql = q[
drop table if exists sqlt_test2;
@@ -179,5 +173,5 @@ is( $t2_c1->type, FOREIGN_KEY, "Constraint is a FK" );
$dbh->rollback;
$dbh->disconnect;
-} # end of SKIP block
+done_testing();
@@ -8,6 +8,7 @@ use FindBin qw($Bin);
use IPC::Open3;
use Test::More;
use Test::SQL::Translator qw(maybe_plan);
+use Text::ParseWords qw(shellwords);
my @script = qw(script sqlt-diff);
my @create1 = qw(data sqlite create.sql);
@@ -23,8 +24,6 @@ BEGIN {
);
}
-$ENV{SQLT_NEWDIFF_NOWARN} = 1;
-
my @mysql_create1 = qw(data mysql create.sql);
my @mysql_create2 = qw(data mysql create2.sql);
@@ -37,7 +36,7 @@ my $mysql_create2 = (-d "t")
: catfile($Bin, "t", @mysql_create2);
# Test for differences
-my $out = _run_cmd ($^X, $sqlt_diff, "$mysql_create1=MySQL", "$mysql_create2=MySQL");
+my $out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create2=MySQL");
like($out, qr/CHANGE COLUMN person_id/, "Detected altered 'person_id' field");
like($out, qr/CHANGE COLUMN iq/, "Detected altered 'iq' field");
@@ -56,7 +55,7 @@ like($out, qr/ADD CONSTRAINT FK5302D47D93FE702E_diff/,
unlike($out, qr/ADD PRIMARY KEY/, "Primary key looks different when it shouldn't");
# Test for quoted output
-$out = _run_cmd ($^X, $sqlt_diff, '--quote=`', "$mysql_create1=MySQL", "$mysql_create2=MySQL");
+$out = _run_cmd ($sqlt_diff, '--quote=`', "$mysql_create1=MySQL", "$mysql_create2=MySQL");
like($out, qr/ALTER TABLE `person`/, "Quoted table name");
like($out, qr/CHANGE COLUMN `person_id`/, "Quoted 'person_id' field");
@@ -65,13 +64,13 @@ like($out, qr/CHANGE COLUMN `name`/, "Quoted 'name' field");
like($out, qr/CHANGE COLUMN `age`/, "Quoted 'age' field");
# Test for sameness
-$out = _run_cmd ($^X, $sqlt_diff, "$mysql_create1=MySQL", "$mysql_create1=MySQL");
+$out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create1=MySQL");
like($out, qr/No differences found/, "Properly detected no differences");
sub _run_cmd {
my $out;
- my $pid = open3( undef, $out, undef, @_ );
+ my $pid = open3( undef, $out, undef, $^X, shellwords($ENV{HARNESS_PERL_SWITCHES}), @_ );
my $res = do { local $/; <$out> };
waitpid($pid, 0);
$res;
@@ -8,6 +8,7 @@ use FindBin qw($Bin);
use Test::More;
use IPC::Open3;
use Test::SQL::Translator qw(maybe_plan);
+use Text::ParseWords qw(shellwords);
my @script = qw(script sqlt-diff-old);
my @create1 = qw(data sqlite create.sql);
@@ -26,14 +27,14 @@ BEGIN {
}
ok(-e $sqlt_diff, 'Found sqlt-diff script');
-my $out = _run_cmd ($^X, $sqlt_diff, "$create1=SQLite", "$create2=SQLite");
+my $out = _run_cmd ($sqlt_diff, "$create1=SQLite", "$create2=SQLite");
like($out, qr/-- Target database SQLite is untested/, "Detected 'untested' comment");
like($out, qr/ALTER TABLE person CHANGE iq/, "Detected altered 'iq' field");
like($out, qr/ALTER TABLE person ADD is_rock_star/,
"Detected missing rock star field");
-$out = _run_cmd ($^X, $sqlt_diff, "$create1=SQLite", "$create1=SQLite");
+$out = _run_cmd ($sqlt_diff, "$create1=SQLite", "$create1=SQLite");
like($out, qr/There were no differences/, "Properly detected no differences");
@@ -49,7 +50,7 @@ my $mysql_create2 = (-d "t")
: catfile($Bin, "t", @mysql_create2);
# Test for differences
-$out = _run_cmd ($^X, $sqlt_diff, "$mysql_create1=MySQL", "$mysql_create2=MySQL");
+$out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create2=MySQL");
unlike($out, qr/-- Target database MySQL is untested/, "Did not detect 'untested' comment");
like($out, qr/ALTER TABLE person CHANGE person_id/, "Detected altered 'person_id' field");
@@ -71,7 +72,7 @@ like($out, qr/ALTER TABLE employee ADD CONSTRAINT FK5302D47D93FE702E_diff/,
unlike($out, qr/ALTER TABLE employee ADD PRIMARY KEY/, "Primary key looks different when it shouldn't");
# Test for sameness
-$out = _run_cmd ($^X, $sqlt_diff, "$mysql_create1=MySQL", "$mysql_create1=MySQL");
+$out = _run_cmd ($sqlt_diff, "$mysql_create1=MySQL", "$mysql_create1=MySQL");
like($out, qr/There were no differences/, "Properly detected no differences");
@@ -86,7 +87,7 @@ my $oracle_create2 = (-d "t")
? catfile($Bin, @oracle_create2)
: catfile($Bin, "t", @oracle_create2);
-$out = _run_cmd ($^X, $sqlt_diff, "$oracle_create1=Oracle", "$oracle_create2=Oracle");
+$out = _run_cmd ($sqlt_diff, "$oracle_create1=Oracle", "$oracle_create2=Oracle");
unlike($out, qr/-- Target database Oracle is untested/, "Did not detect 'untested' comment");
like($out, qr/ALTER TABLE TABLE1 DROP FOREIGN KEY/,
@@ -96,7 +97,7 @@ like($out, qr/ALTER TABLE TABLE1 ADD CONSTRAINT/,
sub _run_cmd {
my $out;
- my $pid = open3( undef, $out, undef, @_ );
+ my $pid = open3( undef, $out, undef, $^X, shellwords($ENV{HARNESS_PERL_SWITCHES}), @_ );
my $res = do { local $/; <$out> };
waitpid($pid, 0);
$res;
@@ -205,6 +205,18 @@ schema:
size:
- 11
- 2
+ value:
+ data_type: double
+ default_value: 0
+ extra: {}
+ is_nullable: 1
+ is_primary_key: 0
+ is_unique: 0
+ name: value
+ order: 7
+ size:
+ - 8
+ - 2
indices:
- fields:
- name
@@ -201,7 +201,7 @@ schema:
is_primary_key: 0
is_unique: 0
name: physical_description
- order: 7
+ order: 8
size:
- 65535
weight:
@@ -216,6 +216,18 @@ schema:
size:
- 11
- 2
+ value:
+ data_type: double
+ default_value: 0.00
+ extra: {}
+ is_nullable: 1
+ is_primary_key: 0
+ is_unique: 0
+ name: value
+ order: 7
+ size:
+ - 8
+ - 2
indices:
- fields:
- name
@@ -279,4 +279,4 @@ translator:
producer_type: SQL::Translator::Producer::YAML
show_warnings: 0
trace: 0
- version: 0.11018
+ version: 0.11020
@@ -0,0 +1,91 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use Test::SQL::Translator;
+use SQL::Translator;
+use SQL::Translator::Diff;
+
+maybe_plan(undef, 'DBD::Pg');
+
+my ( $pgsql, $ddl, $ret, $dsn, $user, $pass );
+if ($ENV{DBICTEST_PG_DSN}) {
+ ($dsn, $user, $pass) = map { $ENV{"DBICTEST_PG_$_"} } qw(DSN USER PASS);
+}
+else {
+ no warnings 'once';
+ maybe_plan(undef, 'Test::PostgreSQL');
+ $pgsql = Test::PostgreSQL->new
+ or plan skip_all => "Can't create test database: $Test::PostgreSQL::errstr";
+ $dsn = $pgsql->dsn;
+};
+
+my $dbh = DBI->connect($dsn, $user, $pass, { RaiseError => 1, AutoCommit => 1 });
+$dbh->do('SET client_min_messages=warning');
+
+my $source_ddl = <<DDL;
+CREATE TABLE sqlt_test_foo (
+ pk SERIAL PRIMARY KEY,
+ bar VARCHAR(10)
+);
+DDL
+
+ok( $ret = $dbh->do($source_ddl), "create table" );
+
+ok( $ret = $dbh->do(q| INSERT INTO sqlt_test_foo (bar) VALUES ('buzz') |), "insert data" );
+
+cmp_ok( $ret, '==', 1, "one row inserted" );
+
+my $target_ddl = <<DDL;
+CREATE TABLE sqlt_test_fluff (
+ pk SERIAL PRIMARY KEY,
+ biff VARCHAR(10)
+);
+DDL
+
+my $source_sqlt = SQL::Translator->new(
+ no_comments => 1,
+ parser => 'SQL::Translator::Parser::PostgreSQL',
+)->translate(\$source_ddl);
+
+my $target_sqlt = SQL::Translator->new(
+ no_comments => 1,
+ parser => 'SQL::Translator::Parser::PostgreSQL',
+)->translate(\$target_ddl);
+
+my $table = $target_sqlt->get_table('sqlt_test_fluff');
+$table->extra( renamed_from => 'sqlt_test_foo' );
+my $field = $table->get_field('biff');
+$field->extra( renamed_from => 'bar' );
+
+my @diff = SQL::Translator::Diff->new({
+ output_db => 'PostgreSQL',
+ source_schema => $source_sqlt,
+ target_schema => $target_sqlt,
+})->compute_differences->produce_diff_sql;
+
+foreach my $line (@diff) {
+ $line =~ s/\n//g;
+ next if $line =~ /^--/;
+ lives_ok { $dbh->do($line) } "$line";
+}
+
+ok ( $ret = $dbh->selectall_arrayref(q(SELECT biff FROM sqlt_test_fluff), { Slice => {} }), "query DB for data" );
+
+cmp_ok( scalar(@$ret), '==', 1, "Got 1 row");
+
+cmp_ok( $ret->[0]->{biff}, 'eq', 'buzz', "col biff has value buzz" );
+
+# Make sure Test::PostgreSQL can kill Pg
+undef $dbh if $pgsql;
+
+END {
+ if ($dbh && !$pgsql) {
+ $dbh->do("drop table if exists sqlt_test_$_") foreach qw(foo fluff);
+ }
+}
+
+done_testing;
@@ -0,0 +1,71 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Exception;
+use DBI;
+use SQL::Translator;
+use SQL::Translator::Parser::SQLite;
+use SQL::Translator::Diff;
+
+eval "use DBD::SQLite";
+plan skip_all => "DBD::SQLite required" if $@;
+
+my ( $dbh , $ddl, $ret );
+
+lives_ok { $dbh = DBI->connect("dbi:SQLite:dbname=:memory:")} "dbi connect";
+
+my $source_ddl = <<DDL;
+CREATE TABLE "Foo" (
+ "foo" INTEGER PRIMARY KEY AUTOINCREMENT,
+ "bar" VARCHAR(10)
+);
+DDL
+
+lives_ok { $ret = $dbh->do($source_ddl) } "create table";
+
+lives_ok { $ret = $dbh->do(q| INSERT INTO Foo (bar) VALUES ('buzz') |) } "insert data";
+
+cmp_ok( $ret, '==', 1, "one row inserted" );
+
+my $target_ddl = <<DDL;
+CREATE TABLE "Foo" (
+ "foo" INTEGER PRIMARY KEY AUTOINCREMENT,
+ "biff" VARCHAR(10)
+);
+DDL
+
+my $source_sqlt = SQL::Translator->new(
+ no_comments => 1,
+ parser => 'SQL::Translator::Parser::SQLite',
+)->translate(\$source_ddl);
+
+my $target_sqlt = SQL::Translator->new(
+ no_comments => 1,
+ parser => 'SQL::Translator::Parser::SQLite',
+)->translate(\$target_ddl);
+
+my $table = $target_sqlt->get_table('Foo');
+my $field = $table->get_field('biff');
+$field->extra( renamed_from => 'bar' );
+
+my @diff = SQL::Translator::Diff->new({
+ output_db => 'SQLite',
+ source_schema => $source_sqlt,
+ target_schema => $target_sqlt,
+})->compute_differences->produce_diff_sql;
+
+foreach my $line (@diff) {
+ $line =~ s/\n//g;
+ lives_ok { $dbh->do($line) || die } "$line";
+}
+
+lives_ok { $ret = $dbh->selectall_arrayref(q(SELECT biff FROM Foo), { Slice => {} }) } "query DB for data";
+
+cmp_ok( scalar(@$ret), '==', 1, "Got 1 row");
+
+cmp_ok( $ret->[0]->{biff}, 'eq', 'buzz', "col biff has value buzz" );
+
+done_testing;