From 28a7ca47205087a07baee8677b4babc7a5e2693d Mon Sep 17 00:00:00 2001 From: Andrew Beverley Date: Wed, 2 Sep 2015 13:52:03 +0100 Subject: [PATCH 01/20] Add index length option for MySQL --- lib/SQL/Translator/Generator/DDL/SQLServer.pm | 4 +- lib/SQL/Translator/Producer/DB2.pm | 4 +- lib/SQL/Translator/Producer/GraphViz.pm | 4 +- lib/SQL/Translator/Producer/HTML.pm | 4 +- lib/SQL/Translator/Producer/MySQL.pm | 4 +- lib/SQL/Translator/Producer/Oracle.pm | 4 +- lib/SQL/Translator/Producer/POD.pm | 4 +- lib/SQL/Translator/Producer/PostgreSQL.pm | 5 +- lib/SQL/Translator/Producer/SQLite.pm | 6 +- lib/SQL/Translator/Producer/Sybase.pm | 4 +- lib/SQL/Translator/Role/ListAttr.pm | 5 +- lib/SQL/Translator/Schema/Index.pm | 25 ++-- lib/SQL/Translator/Utils.pm | 13 +- t/13schema.t | 37 +++++- t/38-mysql-producer.t | 34 +++++- t/45db2-producer.t | 10 +- t/47postgres-producer.t | 8 ++ t/55-oracle-producer.t | 12 ++ t/56-sqlite-producer.t | 6 + t/75-sqlserver-producer.t | 112 ++++++++++++++++++ 20 files changed, 281 insertions(+), 24 deletions(-) create mode 100644 t/75-sqlserver-producer.t diff --git a/lib/SQL/Translator/Generator/DDL/SQLServer.pm b/lib/SQL/Translator/Generator/DDL/SQLServer.pm index 72212295b..d449b72c2 100644 --- a/lib/SQL/Translator/Generator/DDL/SQLServer.pm +++ b/lib/SQL/Translator/Generator/DDL/SQLServer.pm @@ -67,7 +67,9 @@ sub index { 'CREATE INDEX ' . $_[0]->quote($_[1]->name || $_[1]->table->name . '_idx') . ' ON ' . $_[0]->quote($_[1]->table->name) . - ' (' . join( ', ', map $_[0]->quote($_), $_[1]->fields ) . ');' + ' (' . join( ', ', map { + ref $_ ? $_[0]->quote($_->{name}) : $_[0]->quote($_) + } $_[1]->fields ) . ');' } sub unique_constraint_single { diff --git a/lib/SQL/Translator/Producer/DB2.pm b/lib/SQL/Translator/Producer/DB2.pm index 051877f38..7e74c1156 100644 --- a/lib/SQL/Translator/Producer/DB2.pm +++ b/lib/SQL/Translator/Producer/DB2.pm @@ -310,7 +310,9 @@ sub create_index $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '', $index->name, $index->table->name, - join(', ', $index->fields) ); + join(', ', + map { ref $_ ? $_->{name} : $_ } $index->fields + ) ); return $out; } diff --git a/lib/SQL/Translator/Producer/GraphViz.pm b/lib/SQL/Translator/Producer/GraphViz.pm index 3b8ef59d3..d064e82dd 100644 --- a/lib/SQL/Translator/Producer/GraphViz.pm +++ b/lib/SQL/Translator/Producer/GraphViz.pm @@ -465,7 +465,9 @@ sub produce { ? $index->name . ':' : () , - join (', ', $index->fields), + join (', ', + map { ref $_ ? "$_->{name}($_->{size})" : $_ } $index->fields + ), ($index->type eq 'UNIQUE') ? '[U]' : (), ); } diff --git a/lib/SQL/Translator/Producer/HTML.pm b/lib/SQL/Translator/Producer/HTML.pm index dad440d39..17738f5e0 100644 --- a/lib/SQL/Translator/Producer/HTML.pm +++ b/lib/SQL/Translator/Producer/HTML.pm @@ -181,7 +181,9 @@ sub produce { for my $index ( @indices ) { my $name = $index->name || ''; - my $fields = join( ', ', $index->fields ) || ''; + my $fields = join( ', ', + map { ref $_ ? "$_->{name}($_->{size})" : $_ } $index->fields + ) || ''; push @html, $q->Tr({ -class => 'IndexCell' }, diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm index ff756060f..fa0ffe10e 100644 --- a/lib/SQL/Translator/Producer/MySQL.pm +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -684,7 +684,9 @@ sub create_index $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH )) : '', - '(' . join( ', ', map { $generator->quote($_) } $index->fields ) . ')' + '(' . join( ', ', map { + ref $_ ? $generator->quote($_->{name}) . "($_->{size})" : $generator->quote($_) + } $index->fields ) . ')' ); } diff --git a/lib/SQL/Translator/Producer/Oracle.pm b/lib/SQL/Translator/Producer/Oracle.pm index d3f7a1285..b125ee269 100644 --- a/lib/SQL/Translator/Producer/Oracle.pm +++ b/lib/SQL/Translator/Producer/Oracle.pm @@ -403,7 +403,9 @@ sub create_table { for my $index ( $table->get_indices ) { my $index_name = $index->name || ''; my $index_type = $index->type || NORMAL; - my @fields = map { quote($_, $qf) } $index->fields; + my @fields = map { + ref $_ ? quote($_->{name}, $qf) : quote($_, $qf) + } $index->fields; next unless @fields; my @index_options; diff --git a/lib/SQL/Translator/Producer/POD.pm b/lib/SQL/Translator/Producer/POD.pm index 17c378a79..3ca47dc01 100644 --- a/lib/SQL/Translator/Producer/POD.pm +++ b/lib/SQL/Translator/Producer/POD.pm @@ -71,7 +71,9 @@ sub produce { for my $index ( @indices ) { $pod .= "=head4 " . $index->type . "\n\n=over 4\n\n"; $pod .= "=item * Fields = " . - join(', ', $index->fields ) . "\n\n"; + join(', ', + map { ref $_ ? "$_->{name}($_->{size})" : $_ } $index->fields + ) . "\n\n"; $pod .= "=back\n\n"; } } diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index 29d152aed..15ad57e56 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/lib/SQL/Translator/Producer/PostgreSQL.pm @@ -561,7 +561,10 @@ sub create_index } my $def_start = 'CONSTRAINT ' . $generator->quote($name) . ' '; - my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')'; + my $field_names = '(' . join(", ", (map { + my $name = ref $_ ? $_->{name} : $_; + $name =~ /\(.*\)/ ? $name : ( $generator->quote($name) ); + } @fields)) . ')'; if ( $type eq PRIMARY_KEY ) { push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names; } diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm index 9cc92aff7..e9f8125b4 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -298,7 +298,11 @@ sub create_index my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : ''; # strip any field size qualifiers as SQLite doesn't like these - my @fields = map { s/\(\d+\)$//; _generator()->quote($_) } $index->fields; + my @fields = map { + $_ = $_->{name} if ref $_; # Remove any index lengths + s/\(\d+\)$//; + _generator()->quote($_) + } $index->fields; $index_table_name = _generator()->quote($index_table_name); warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN; my $index_def = diff --git a/lib/SQL/Translator/Producer/Sybase.pm b/lib/SQL/Translator/Producer/Sybase.pm index fec655a64..18a799456 100644 --- a/lib/SQL/Translator/Producer/Sybase.pm +++ b/lib/SQL/Translator/Producer/Sybase.pm @@ -281,7 +281,9 @@ sub produce { push @index_defs, 'CREATE INDEX ' . $index->name . " ON $table_name (". - join( ', ', $index->fields ) . ");"; + join( ', ', + map { ref $_ ? $_->{name} : $_ } $index->fields + ) . ");"; } my $create_statement; diff --git a/lib/SQL/Translator/Role/ListAttr.pm b/lib/SQL/Translator/Role/ListAttr.pm index fd4070031..84b64f0b9 100644 --- a/lib/SQL/Translator/Role/ListAttr.pm +++ b/lib/SQL/Translator/Role/ListAttr.pm @@ -22,7 +22,7 @@ attributes. =cut -use SQL::Translator::Utils qw(parse_list_arg ex2err uniq); +use SQL::Translator::Utils qw(parse_list_arg ex2err uniq uniq_keys); use Sub::Quote qw(quote_sub); use Package::Variant ( @@ -83,8 +83,11 @@ sub make_variant { my $may_throw = delete $arguments{may_throw}; my $undef_if_empty = delete $arguments{undef_if_empty}; my $append = delete $arguments{append}; + my $uniq_keys = delete $arguments{uniq_keys}; my $coerce = delete $arguments{uniq} ? sub { [ uniq @{parse_list_arg($_[0])} ] } + : $uniq_keys + ? sub { [ uniq_keys $uniq_keys, @{parse_list_arg($_[0])} ] } : \&parse_list_arg; has($name => ( diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index 5363745b9..b8947202b 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -64,9 +64,14 @@ names and keep them in order by the first occurrence of a field name. my @fields = $index->fields; +The length of an index can be specified as follows (only has any effect +with a MySQL database): + + $index->fields( 'id', { name => 'firstname', size => 15 } ); + =cut -with ListAttr fields => ( uniq => 1 ); +with ListAttr fields => ( uniq_keys => 'name' ); sub is_valid { @@ -174,8 +179,10 @@ around equals => sub { return 0 unless $self->$orig($other); unless ($ignore_index_names) { - unless ((!$self->name && ($other->name eq $other->fields->[0])) || - (!$other->name && ($self->name eq $self->fields->[0]))) { + my $self_first = ref $self->fields->[0] ? $self->fields->[0]->{name} : $self->fields->[0] || ''; + my $other_first = ref $other->fields->[0] ? $other->fields->[0]->{name} : $other->fields->[0] || ''; + unless ((!$self->name && ($other->name eq $other_first)) || + (!$other->name && ($self->name eq $self_first))) { return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; } } @@ -185,13 +192,15 @@ around equals => sub { # Check fields, regardless of order my %otherFields = (); # create a hash of the other fields foreach my $otherField ($other->fields) { - $otherField = uc($otherField) if $case_insensitive; - $otherFields{$otherField} = 1; + my $name = ref $otherField ? $otherField->{name} : $otherField; + $name = uc($name) if $case_insensitive; + $otherFields{$name} = ref $otherField ? $otherField->{size} : -1; # -1 == no length. Easier comparison. } foreach my $selfField ($self->fields) { # check for self fields in hash - $selfField = uc($selfField) if $case_insensitive; - return 0 unless $otherFields{$selfField}; - delete $otherFields{$selfField}; + my ($name, $size) = ref $selfField ? ($selfField->{name}, $selfField->{size}) : ($selfField, -1); + $name = uc($name) if $case_insensitive; + return 0 unless exists $otherFields{$name} && $otherFields{$name} == $size; + delete $otherFields{$name}; } # Check all other fields were accounted for return 0 unless keys %otherFields == 0; diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm index ccc7ad3a2..9e446d3d1 100644 --- a/lib/SQL/Translator/Utils.pm +++ b/lib/SQL/Translator/Utils.pm @@ -16,7 +16,7 @@ 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 batch_alter_table_statements - uniq throw ex2err carp_ro + uniq uniq_keys throw ex2err carp_ro normalize_quote_options ); use constant COLLISION_TAG_LENGTH => 8; @@ -130,7 +130,7 @@ sub parse_list_arg { # # This protects stringification of references. # - if ( @$list && ref $list->[0] ) { + if ( @$list && grep { ref $_ } @$list ) { return $list; } # @@ -375,6 +375,15 @@ sub uniq { ) } @_; } +sub uniq_keys { + my $key = shift; + my %seen; + grep { + my $name = ref $_ ? $_->{$key} : $_; + not ( $seen{$name}++ ); + } @_; +} + sub throw { die SQL::Translator::Utils::Error->new($_[0]); } diff --git a/t/13schema.t b/t/13schema.t index 3d9df323d..c18bafc7a 100644 --- a/t/13schema.t +++ b/t/13schema.t @@ -248,10 +248,45 @@ require_ok( 'SQL::Translator::Schema' ); isa_ok( $index2, 'SQL::Translator::Schema::Index', 'Index' ); is( $index2->name, 'bar', 'Index name is "bar"' ); + my $index3 = $person_table->add_index( name => "sized", fields => [ { name => 'forename', size => 15} ] ) + or warn $person_table->error; + isa_ok( $index3, 'SQL::Translator::Schema::Index', 'Index' ); + is( $index3->name, 'sized', 'Index name is "sized"' ); + + # Test index comparison function. + # 2 completely different indexes + ok( !$index3->equals($index2), "2 different indexes return false on equals() function (simple)" ); + + # Same indexes with different lengths + my $index4 = SQL::Translator::Schema::Index->new( + name => "sized", fields => [ { name => 'forename', size => 20} ] + ); + ok( !$index3->equals($index4), "2 different indexes return false on equals() function (index length different)" ); + + # Identical indexes with lengths + my $index5 = SQL::Translator::Schema::Index->new( + name => "sized", fields => [ { name => 'forename', size => 15} ] + ); + ok( $index3->equals($index5), "2 identical indexes return true on equals() (with index length)" ); + + # Identical indexes without lengths + my $index6 = SQL::Translator::Schema::Index->new( name => "foo", fields => [qw/foo age/] ); + ok( $index6->equals($index1), "2 identical indexes return true on equals() (without index length)" ); + + # Check comparison of index names + my $index7 = SQL::Translator::Schema::Index->new( name => "bar" ); + ok( $index7->equals($index2), "2 empty indexes return true on equals()" ); + + # Check that 2 indexes are equal, if one doesn't have a name, and the + # other has a name that is the same as the first field + my $index8 = SQL::Translator::Schema::Index->new( fields => [qw/foo age/] ); + ok( $index8->equals($index6), "Compare 2 indexes, one without name" ); + my $indices = $person_table->get_indices; - is( scalar @$indices, 2, 'Two indices' ); + is( scalar @$indices, 3, 'Two indices' ); is( $indices->[0]->name, 'foo', '"foo" index' ); is( $indices->[1]->name, 'bar', '"bar" index' ); + is( $indices->[2]->name, 'sized', '"sized" index' ); # # $table-> drop_index diff --git a/t/38-mysql-producer.t b/t/38-mysql-producer.t index b3c3bf88c..b2f52c154 100644 --- a/t/38-mysql-producer.t +++ b/t/38-mysql-producer.t @@ -19,7 +19,7 @@ use FindBin qw/$Bin/; #============================================================================= BEGIN { - maybe_plan(75, + maybe_plan(79, 'YAML', 'SQL::Translator::Producer::MySQL', 'Test::Differences', @@ -782,6 +782,38 @@ EOV } } +{ + my $table = SQL::Translator::Schema::Table->new( name => 'foobar', fields => ['foo'] ); + + { + my $index = $table->add_index(name => 'myindex', fields => ['foo']); + my ($def) = SQL::Translator::Producer::MySQL::create_index($index); + is($def, 'INDEX myindex (foo)', 'index created'); + } + + { + my $index = $table->add_index(fields => ['foo']); + my ($def) = SQL::Translator::Producer::MySQL::create_index($index); + is($def, 'INDEX (foo)', 'index created'); + } + + { + my $index = $table->add_index(fields => [ { name => 'foo', size => 25 } ], type => 'unique'); + my ($def) = SQL::Translator::Producer::MySQL::create_index($index); + is($def, 'UNIQUE INDEX (foo(25))', 'unique index created'); + } + + { + my $index = $table->add_index(name => 'sized', fields => [ + 'foobar', + { name => 'foo', size => 10 }, + { name => 'bar', size => 15 }, + ]); + my ($def) = SQL::Translator::Producer::MySQL::create_index($index); + is($def, 'INDEX sized (foobar, foo(10), bar(15))', 'index created'); + } +} + { # test for rt62250 my $table = SQL::Translator::Schema::Table->new(name => 'table'); $table->add_field( diff --git a/t/45db2-producer.t b/t/45db2-producer.t index 411b6e9bc..01e17caab 100644 --- a/t/45db2-producer.t +++ b/t/45db2-producer.t @@ -14,7 +14,7 @@ use FindBin qw/$Bin/; #============================================================================= BEGIN { - maybe_plan(4, + maybe_plan(6, 'SQL::Translator::Producer::DB2', 'Test::Differences', ) @@ -58,5 +58,13 @@ my $add_field = SQL::Translator::Producer::DB2::add_field($field1); is($add_field, 'ALTER TABLE mytable ADD COLUMN myfield VARCHAR(10)', 'Add field works'); +my $index = $table->add_index(name => 'myindex', fields => ['foo']); +my ($def) = SQL::Translator::Producer::DB2::create_index($index); +is($def, 'CREATE INDEX myindex ON mytable ( foo );', 'index created'); + +my $index2 = $table->add_index(name => 'myindex', fields => [ { name => 'foo', size => 15 } ]); +my ($def2) = SQL::Translator::Producer::DB2::create_index($index); +is($def2, 'CREATE INDEX myindex ON mytable ( foo );', 'index created'); + my $drop_field = SQL::Translator::Producer::DB2::drop_field($field2); is($drop_field, '', 'Drop field works'); diff --git a/t/47postgres-producer.t b/t/47postgres-producer.t index bf57a015c..a464d8859 100644 --- a/t/47postgres-producer.t +++ b/t/47postgres-producer.t @@ -588,6 +588,14 @@ is($view2_sql1, $view2_sql_replace, 'correct "CREATE OR REPLACE VIEW" SQL 2'); is($def, 'CREATE INDEX "myindex" on "foobar" ("foo")', 'index created w/ quotes'); } + { + my $index = $table->add_index(name => 'myindex', fields => [ { name => 'foo', size => 20 } ]); + my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index); + is($def, "CREATE INDEX myindex on foobar (foo)", 'index created'); + ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote); + is($def, 'CREATE INDEX "myindex" on "foobar" ("foo")', 'index created w/ quotes'); + } + { my $index = $table->add_index(name => 'myindex', fields => ['lower(foo)']); my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index); diff --git a/t/55-oracle-producer.t b/t/55-oracle-producer.t index 8f90c31fe..926ebc2b5 100644 --- a/t/55-oracle-producer.t +++ b/t/55-oracle-producer.t @@ -68,6 +68,9 @@ use SQL::Translator::Producer::Oracle; type => FOREIGN_KEY, ); + my $index1 = $table1->add_index(name => 'myfooindex', fields => ['foo']); + my $index2 = $table1->add_index(name => 'mybarindex', fields => [ { name => 'bar', size => 10 } ]); + my ($table1_def, $fk1_def, $trigger1_def, $index1_def, $constraint1_def ) = SQL::Translator::Producer::Oracle::create_table($table1); @@ -78,6 +81,15 @@ use SQL::Translator::Producer::Oracle; ], 'correct "CREATE CONSTRAINT" SQL' ); + + is_deeply( + $index1_def, + [ 'CREATE INDEX myfooindex on table1 (foo)', + 'CREATE INDEX mybarindex on table1 (bar)' + ], + 'correct "CREATE INDEX" SQL' + ); + } done_testing(); diff --git a/t/56-sqlite-producer.t b/t/56-sqlite-producer.t index d0d2cfeb2..12b2ad488 100644 --- a/t/56-sqlite-producer.t +++ b/t/56-sqlite-producer.t @@ -193,6 +193,12 @@ $SQL::Translator::Producer::SQLite::NO_QUOTES = 0; is($def, 'CREATE INDEX "myindex" ON "foobar" ("foo")', 'index created'); } + { + my $index = $table->add_index(name => 'myindex2', fields => [ { name => 'foo', size => 15 } ]); + my ($def) = SQL::Translator::Producer::SQLite::create_index($index); + is($def, 'CREATE INDEX "myindex2" ON "foobar" ("foo")', 'index created'); + } + { my $index = $table->add_index(fields => ['foo']); my ($def) = SQL::Translator::Producer::SQLite::create_index($index); diff --git a/t/75-sqlserver-producer.t b/t/75-sqlserver-producer.t new file mode 100644 index 000000000..cf8fe4f4d --- /dev/null +++ b/t/75-sqlserver-producer.t @@ -0,0 +1,112 @@ +#!/usr/bin/perl -w +# vim:filetype=perl + +use strict; +use Test::More; +use Test::SQL::Translator qw(maybe_plan); + +use FindBin qw/$Bin/; + +BEGIN { + maybe_plan(2, + 'YAML', + 'SQL::Translator::Producer::SQLServer', + 'Test::Differences', + ) +} +use Test::Differences; +use SQL::Translator; + +# Simple table in YAML format to test basic functionality +my $yaml_in = <new( + show_warnings => 1, + no_comments => 1, + from => "YAML", + to => "SQLServer", + quote_table_names => 1, + quote_field_names => 1 +); + +my $generator = $sqlt->translate(\$yaml_in) + or die "Translate error:".$sqlt->error; +ok $generator ne "", "Produced something!"; + +my $correct = join("\n", @stmts); +eq_or_diff $correct, $generator, "Scalar output looks correct"; From 9a738f7b890fe7a65337a1a874a62159adaba6b8 Mon Sep 17 00:00:00 2001 From: Jess Robinson Date: Fri, 6 Nov 2015 10:57:32 +0000 Subject: [PATCH 02/20] Name index field "size" to "prefix_length", hide plain/refy fieldness --- lib/SQL/Translator/Generator/DDL/SQLServer.pm | 4 +-- lib/SQL/Translator/Producer/DB2.pm | 4 +-- lib/SQL/Translator/Producer/GraphViz.pm | 4 +-- lib/SQL/Translator/Producer/HTML.pm | 4 +-- lib/SQL/Translator/Producer/MySQL.pm | 4 +-- lib/SQL/Translator/Producer/Oracle.pm | 4 +-- lib/SQL/Translator/Producer/POD.pm | 4 +-- lib/SQL/Translator/Producer/PostgreSQL.pm | 7 ++--- lib/SQL/Translator/Producer/SQLite.pm | 6 +--- lib/SQL/Translator/Producer/Sybase.pm | 4 +-- lib/SQL/Translator/Schema/Index.pm | 31 +++++++++++++++++-- t/13schema.t | 2 +- t/38-mysql-producer.t | 6 ++-- t/55-oracle-producer.t | 2 +- t/56-sqlite-producer.t | 2 +- t/75-sqlserver-producer.t | 2 +- 16 files changed, 48 insertions(+), 42 deletions(-) diff --git a/lib/SQL/Translator/Generator/DDL/SQLServer.pm b/lib/SQL/Translator/Generator/DDL/SQLServer.pm index d449b72c2..3fd681d75 100644 --- a/lib/SQL/Translator/Generator/DDL/SQLServer.pm +++ b/lib/SQL/Translator/Generator/DDL/SQLServer.pm @@ -67,9 +67,7 @@ sub index { 'CREATE INDEX ' . $_[0]->quote($_[1]->name || $_[1]->table->name . '_idx') . ' ON ' . $_[0]->quote($_[1]->table->name) . - ' (' . join( ', ', map { - ref $_ ? $_[0]->quote($_->{name}) : $_[0]->quote($_) - } $_[1]->fields ) . ');' + ' (' . join( ', ', map $_[0]->quote($_), $_[1]->field_names ) . ');' } sub unique_constraint_single { diff --git a/lib/SQL/Translator/Producer/DB2.pm b/lib/SQL/Translator/Producer/DB2.pm index 7e74c1156..90928a39e 100644 --- a/lib/SQL/Translator/Producer/DB2.pm +++ b/lib/SQL/Translator/Producer/DB2.pm @@ -310,9 +310,7 @@ sub create_index $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '', $index->name, $index->table->name, - join(', ', - map { ref $_ ? $_->{name} : $_ } $index->fields - ) ); + join(', ', $index->field_names) ); return $out; } diff --git a/lib/SQL/Translator/Producer/GraphViz.pm b/lib/SQL/Translator/Producer/GraphViz.pm index d064e82dd..fc051403a 100644 --- a/lib/SQL/Translator/Producer/GraphViz.pm +++ b/lib/SQL/Translator/Producer/GraphViz.pm @@ -465,9 +465,7 @@ sub produce { ? $index->name . ':' : () , - join (', ', - map { ref $_ ? "$_->{name}($_->{size})" : $_ } $index->fields - ), + join (', ', $index->field_names_with_lengths), ($index->type eq 'UNIQUE') ? '[U]' : (), ); } diff --git a/lib/SQL/Translator/Producer/HTML.pm b/lib/SQL/Translator/Producer/HTML.pm index 17738f5e0..5e5161ab5 100644 --- a/lib/SQL/Translator/Producer/HTML.pm +++ b/lib/SQL/Translator/Producer/HTML.pm @@ -181,9 +181,7 @@ sub produce { for my $index ( @indices ) { my $name = $index->name || ''; - my $fields = join( ', ', - map { ref $_ ? "$_->{name}($_->{size})" : $_ } $index->fields - ) || ''; + my $fields = join( ', ', $index->field_names_with_lengths ) || ''; push @html, $q->Tr({ -class => 'IndexCell' }, diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm index fa0ffe10e..546f6366c 100644 --- a/lib/SQL/Translator/Producer/MySQL.pm +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -684,8 +684,8 @@ sub create_index $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH )) : '', - '(' . join( ', ', map { - ref $_ ? $generator->quote($_->{name}) . "($_->{size})" : $generator->quote($_) + '(' . join( ', ', map { + ref $_ ? $generator->quote($_->{name}) . "($_->{prefix_length})" : $generator->quote($_) } $index->fields ) . ')' ); } diff --git a/lib/SQL/Translator/Producer/Oracle.pm b/lib/SQL/Translator/Producer/Oracle.pm index b125ee269..bf2ba716f 100644 --- a/lib/SQL/Translator/Producer/Oracle.pm +++ b/lib/SQL/Translator/Producer/Oracle.pm @@ -403,9 +403,7 @@ sub create_table { for my $index ( $table->get_indices ) { my $index_name = $index->name || ''; my $index_type = $index->type || NORMAL; - my @fields = map { - ref $_ ? quote($_->{name}, $qf) : quote($_, $qf) - } $index->fields; + my @fields = map { quote($_, $qf) } $index->field_names; next unless @fields; my @index_options; diff --git a/lib/SQL/Translator/Producer/POD.pm b/lib/SQL/Translator/Producer/POD.pm index 3ca47dc01..ad7bc147e 100644 --- a/lib/SQL/Translator/Producer/POD.pm +++ b/lib/SQL/Translator/Producer/POD.pm @@ -71,9 +71,7 @@ sub produce { for my $index ( @indices ) { $pod .= "=head4 " . $index->type . "\n\n=over 4\n\n"; $pod .= "=item * Fields = " . - join(', ', - map { ref $_ ? "$_->{name}($_->{size})" : $_ } $index->fields - ) . "\n\n"; + join(', ', $index->field_names_with_lengths ) . "\n\n"; $pod .= "=back\n\n"; } } diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index 9cba574bd..c3c8985bc 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/lib/SQL/Translator/Producer/PostgreSQL.pm @@ -505,7 +505,7 @@ sub create_geometry_constraints { || join('_', $table_name, 'idx', ++$index_name{ $table_name }); my $type = $index->type || NORMAL; - my @fields = $index->fields; + my @fields = $index->field_names; return unless @fields; my $index_using; @@ -526,10 +526,7 @@ sub create_geometry_constraints { } my $def_start = 'CONSTRAINT ' . $generator->quote($name) . ' '; - my $field_names = '(' . join(", ", (map { - my $name = ref $_ ? $_->{name} : $_; - $name =~ /\(.*\)/ ? $name : ( $generator->quote($name) ); - } @fields)) . ')'; + my $field_names = '(' . join(", ", (map { $_ =~ /\(.*\)/ ? $_ : ( $generator->quote($_) ) } @fields)) . ')'; if ( $type eq PRIMARY_KEY ) { push @constraint_defs, "${def_start}PRIMARY KEY ".$field_names; } diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm index e9f8125b4..28eec884a 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -298,11 +298,7 @@ sub create_index my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : ''; # strip any field size qualifiers as SQLite doesn't like these - my @fields = map { - $_ = $_->{name} if ref $_; # Remove any index lengths - s/\(\d+\)$//; - _generator()->quote($_) - } $index->fields; + my @fields = map { s/\(\d+\)$//; _generator()->quote($_) } $index->field_names; $index_table_name = _generator()->quote($index_table_name); warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN; my $index_def = diff --git a/lib/SQL/Translator/Producer/Sybase.pm b/lib/SQL/Translator/Producer/Sybase.pm index 18a799456..a849f8838 100644 --- a/lib/SQL/Translator/Producer/Sybase.pm +++ b/lib/SQL/Translator/Producer/Sybase.pm @@ -281,9 +281,7 @@ sub produce { push @index_defs, 'CREATE INDEX ' . $index->name . " ON $table_name (". - join( ', ', - map { ref $_ ? $_->{name} : $_ } $index->fields - ) . ");"; + join( ', ',$index->field_names ) . ");"; } my $create_statement; diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index b8947202b..601f92a62 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -67,7 +67,7 @@ names and keep them in order by the first occurrence of a field name. The length of an index can be specified as follows (only has any effect with a MySQL database): - $index->fields( 'id', { name => 'firstname', size => 15 } ); + $index->fields( 'id', { name => 'firstname', prefix_length => 15 } ); =cut @@ -112,6 +112,33 @@ has name => ( default => quote_sub(q{ '' }), ); +=head2 field_names + +Return just the index field names for the case when we don't care whether +the "prefix_length" is specified or not. + +=cut + +sub field_names { + my ($self) = @_; + + return ( map { ref $_ ? $_->{name} : $_ } ($self->fields) ); +} + +=head2 fields_with_lengths + +Return the index field names with the prefix_length appended if set. + +=cut + +sub fields_with_lengths { + my ($self) = @_; + + print STDERR Data::Dumper::Dumper($self->fields); + return ( map { ref $_ ? "$_->{name}($_->{prefix_length})" : $_ } + ($self->fields) ); +} + =head2 options Get or set the index's options (e.g., "using" or "where" for PG). Returns @@ -197,7 +224,7 @@ around equals => sub { $otherFields{$name} = ref $otherField ? $otherField->{size} : -1; # -1 == no length. Easier comparison. } foreach my $selfField ($self->fields) { # check for self fields in hash - my ($name, $size) = ref $selfField ? ($selfField->{name}, $selfField->{size}) : ($selfField, -1); + my ($name, $size) = ref $selfField ? ($selfField->{name}, $selfField->{prefix_length}) : ($selfField, -1); $name = uc($name) if $case_insensitive; return 0 unless exists $otherFields{$name} && $otherFields{$name} == $size; delete $otherFields{$name}; diff --git a/t/13schema.t b/t/13schema.t index c18bafc7a..48cc15205 100644 --- a/t/13schema.t +++ b/t/13schema.t @@ -248,7 +248,7 @@ require_ok( 'SQL::Translator::Schema' ); isa_ok( $index2, 'SQL::Translator::Schema::Index', 'Index' ); is( $index2->name, 'bar', 'Index name is "bar"' ); - my $index3 = $person_table->add_index( name => "sized", fields => [ { name => 'forename', size => 15} ] ) + my $index3 = $person_table->add_index( name => "sized", fields => [ { name => 'forename', prefix_length => 15} ] ) or warn $person_table->error; isa_ok( $index3, 'SQL::Translator::Schema::Index', 'Index' ); is( $index3->name, 'sized', 'Index name is "sized"' ); diff --git a/t/38-mysql-producer.t b/t/38-mysql-producer.t index b2f52c154..8b03c50d7 100644 --- a/t/38-mysql-producer.t +++ b/t/38-mysql-producer.t @@ -798,7 +798,7 @@ EOV } { - my $index = $table->add_index(fields => [ { name => 'foo', size => 25 } ], type => 'unique'); + my $index = $table->add_index(fields => [ { name => 'foo', prefix_length => 25 } ], type => 'unique'); my ($def) = SQL::Translator::Producer::MySQL::create_index($index); is($def, 'UNIQUE INDEX (foo(25))', 'unique index created'); } @@ -806,8 +806,8 @@ EOV { my $index = $table->add_index(name => 'sized', fields => [ 'foobar', - { name => 'foo', size => 10 }, - { name => 'bar', size => 15 }, + { name => 'foo', prefix_length => 10 }, + { name => 'bar', prefix_length => 15 }, ]); my ($def) = SQL::Translator::Producer::MySQL::create_index($index); is($def, 'INDEX sized (foobar, foo(10), bar(15))', 'index created'); diff --git a/t/55-oracle-producer.t b/t/55-oracle-producer.t index 926ebc2b5..69b0174cb 100644 --- a/t/55-oracle-producer.t +++ b/t/55-oracle-producer.t @@ -69,7 +69,7 @@ use SQL::Translator::Producer::Oracle; ); my $index1 = $table1->add_index(name => 'myfooindex', fields => ['foo']); - my $index2 = $table1->add_index(name => 'mybarindex', fields => [ { name => 'bar', size => 10 } ]); + my $index2 = $table1->add_index(name => 'mybarindex', fields => [ { name => 'bar', prefix_length => 10 } ]); my ($table1_def, $fk1_def, $trigger1_def, $index1_def, $constraint1_def diff --git a/t/56-sqlite-producer.t b/t/56-sqlite-producer.t index 12b2ad488..ac87f60aa 100644 --- a/t/56-sqlite-producer.t +++ b/t/56-sqlite-producer.t @@ -194,7 +194,7 @@ $SQL::Translator::Producer::SQLite::NO_QUOTES = 0; } { - my $index = $table->add_index(name => 'myindex2', fields => [ { name => 'foo', size => 15 } ]); + my $index = $table->add_index(name => 'myindex2', fields => [ { name => 'foo', prefix_length => 15 } ]); my ($def) = SQL::Translator::Producer::SQLite::create_index($index); is($def, 'CREATE INDEX "myindex2" ON "foobar" ("foo")', 'index created'); } diff --git a/t/75-sqlserver-producer.t b/t/75-sqlserver-producer.t index cf8fe4f4d..18ca9c7fb 100644 --- a/t/75-sqlserver-producer.t +++ b/t/75-sqlserver-producer.t @@ -57,7 +57,7 @@ schema: - type: NORMAL fields: - name: id - size: 10 + prefix_length: 10 name: index_1 - type: NORMAL fields: From b56de8884a7a0fa84de1d666a1307cab55e8cae7 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Thu, 15 Sep 2022 15:44:16 +0100 Subject: [PATCH 03/20] Fix failing tests --- lib/SQL/Translator/Producer/MySQL.pm | 2 +- lib/SQL/Translator/Producer/PostgreSQL.pm | 2 +- lib/SQL/Translator/Schema/Index.pm | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm index 2f5299e98..22cb9dccb 100644 --- a/lib/SQL/Translator/Producer/MySQL.pm +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -684,7 +684,7 @@ sub create_index $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH )) : '', - '(' . join( ', ', map { + '(' . join( ', ', map { ref $_ ? $generator->quote($_->{name}) . "($_->{prefix_length})" : $generator->quote($_) } $index->fields ) . ')' ); diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index c930170fa..a92f43fa0 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/lib/SQL/Translator/Producer/PostgreSQL.pm @@ -42,7 +42,7 @@ generated for dropping objects in the database will contain IF EXISTS. Generates table and column comments via the COMMENT command rather than as a comment in the DDL. You could then look it up with \dt+ or \d+ (for tables and columns respectively) in psql. The comment is dollar quoted with $comment$ so you can include ' in it. Just to clarify: you get this - + CREATE TABLE foo ...; COMMENT on TABLE foo IS $comment$hi there$comment$; diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index bd0a47809..2826c7a6c 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -135,7 +135,7 @@ sub fields_with_lengths { my ($self) = @_; print STDERR Data::Dumper::Dumper($self->fields); - return ( map { ref $_ ? "$_->{name}($_->{prefix_length})" : $_ } + return ( map { ref $_ ? "$_->{name}($_->{prefix_length})" : $_ } ($self->fields) ); } From 71ac26d7e48b736443b20611972d92f45d299466 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Thu, 15 Sep 2022 15:46:28 +0100 Subject: [PATCH 04/20] Fix failing test --- lib/SQL/Translator/Schema/Index.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index 2826c7a6c..a2a776164 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -136,7 +136,7 @@ sub fields_with_lengths { print STDERR Data::Dumper::Dumper($self->fields); return ( map { ref $_ ? "$_->{name}($_->{prefix_length})" : $_ } - ($self->fields) ); + ($self->fields) ); } =head2 options From e48176e0c2988b061ddc2297d3cee3df6e2996a8 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Thu, 15 Sep 2022 16:04:27 +0100 Subject: [PATCH 05/20] Fix incorrect index names in YAML producer --- lib/SQL/Translator/Producer/YAML.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index bdf4b0555..d1bfe7eff 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -173,7 +173,7 @@ sub view_index { return { 'name' => scalar $index->name, 'type' => scalar $index->type, - 'fields' => [ map { ref($_) ? $_->name : $_ } $index->fields ], + 'fields' => [ $index->field_names ], 'options' => scalar $index->options, keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; From 373a0113b92ccb837a9ea63d13d3f636dd56e474 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Fri, 16 Sep 2022 10:52:11 +0100 Subject: [PATCH 06/20] Change missed key to new prefix_length name --- lib/SQL/Translator/Schema/Index.pm | 2 +- t/13schema.t | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index a2a776164..88fac5892 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -221,7 +221,7 @@ around equals => sub { foreach my $otherField ($other->fields) { my $name = ref $otherField ? $otherField->{name} : $otherField; $name = uc($name) if $case_insensitive; - $otherFields{$name} = ref $otherField ? $otherField->{size} : -1; # -1 == no length. Easier comparison. + $otherFields{$name} = ref $otherField ? $otherField->{prefix_length} : -1; # -1 == no length. Easier comparison. } foreach my $selfField ($self->fields) { # check for self fields in hash my ($name, $size) = ref $selfField ? ($selfField->{name}, $selfField->{prefix_length}) : ($selfField, -1); diff --git a/t/13schema.t b/t/13schema.t index 48cc15205..f95f3a5a2 100644 --- a/t/13schema.t +++ b/t/13schema.t @@ -259,13 +259,13 @@ require_ok( 'SQL::Translator::Schema' ); # Same indexes with different lengths my $index4 = SQL::Translator::Schema::Index->new( - name => "sized", fields => [ { name => 'forename', size => 20} ] + name => "sized", fields => [ { name => 'forename', prefix_length => 20} ] ); ok( !$index3->equals($index4), "2 different indexes return false on equals() function (index length different)" ); # Identical indexes with lengths my $index5 = SQL::Translator::Schema::Index->new( - name => "sized", fields => [ { name => 'forename', size => 15} ] + name => "sized", fields => [ { name => 'forename', prefix_length => 15} ] ); ok( $index3->equals($index5), "2 identical indexes return true on equals() (with index length)" ); From 2e52bd6813e584ec61af3aad71f39e8253896a46 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Fri, 16 Sep 2022 12:01:04 +0100 Subject: [PATCH 07/20] Fix index lengths not being produced in YAML This commit fixes a bug whereby index lengths (normally only used in MySQL) were not being produced by the YAML producer. This matters, as sometimes YAML is used to produce diffs of schema changes (e.g. DBIC Migration) and before this commit diffs of indexes were not working correctly. --- lib/SQL/Translator/Producer/YAML.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index d1bfe7eff..507010230 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -173,7 +173,7 @@ sub view_index { return { 'name' => scalar $index->name, 'type' => scalar $index->type, - 'fields' => [ $index->field_names ], + 'fields' => [ $index->fields ], 'options' => scalar $index->options, keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; From 1c413caa3d75275af81292741f28684da19b95ac Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Sun, 18 Jun 2023 21:58:43 +0100 Subject: [PATCH 08/20] Fix failing tests --- lib/SQL/Translator/Producer/Oracle.pm | 2 +- t/55-oracle-producer.t | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/SQL/Translator/Producer/Oracle.pm b/lib/SQL/Translator/Producer/Oracle.pm index 32e2cb3d2..e5f76240e 100644 --- a/lib/SQL/Translator/Producer/Oracle.pm +++ b/lib/SQL/Translator/Producer/Oracle.pm @@ -677,7 +677,7 @@ sub create_index { $index_name ? quote($index_name, $qf): '', 'ON', quote($index->table, $qt), - '(' . join( ', ', map { quote($_, $qf) } $index->fields ) . ")$index_options" + '(' . join( ', ', map { quote($_, $qf) } $index->field_names ) . ")$index_options" ); } diff --git a/t/55-oracle-producer.t b/t/55-oracle-producer.t index 761d2c4b1..efc98d06d 100644 --- a/t/55-oracle-producer.t +++ b/t/55-oracle-producer.t @@ -85,8 +85,8 @@ use SQL::Translator::Producer::Oracle; is_deeply( $index1_def, - [ 'CREATE INDEX myfooindex on table1 (foo)', - 'CREATE INDEX mybarindex on table1 (bar)' + [ 'CREATE INDEX myfooindex ON table1 (foo)', + 'CREATE INDEX mybarindex ON table1 (bar)' ], 'correct "CREATE INDEX" SQL' ); From a10be29b0f33a9496d4863fedb853b670d263ffb Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Sun, 18 Jun 2023 22:14:38 +0100 Subject: [PATCH 09/20] Fix warnings when running tests --- t/45db2-producer.t | 2 +- t/47postgres-producer.t | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/t/45db2-producer.t b/t/45db2-producer.t index 01e17caab..35c01cf2e 100644 --- a/t/45db2-producer.t +++ b/t/45db2-producer.t @@ -62,7 +62,7 @@ my $index = $table->add_index(name => 'myindex', fields => ['foo']); my ($def) = SQL::Translator::Producer::DB2::create_index($index); is($def, 'CREATE INDEX myindex ON mytable ( foo );', 'index created'); -my $index2 = $table->add_index(name => 'myindex', fields => [ { name => 'foo', size => 15 } ]); +my $index2 = $table->add_index(name => 'myindex', fields => [ { name => 'foo', prefix_length => 15 } ]); my ($def2) = SQL::Translator::Producer::DB2::create_index($index); is($def2, 'CREATE INDEX myindex ON mytable ( foo );', 'index created'); diff --git a/t/47postgres-producer.t b/t/47postgres-producer.t index d055c8f24..b8095552a 100644 --- a/t/47postgres-producer.t +++ b/t/47postgres-producer.t @@ -649,7 +649,7 @@ is($view2_sql1, $view2_sql_replace, 'correct "CREATE OR REPLACE VIEW" SQL 2'); } { - my $index = $table->add_index(name => 'myindex', fields => [ { name => 'foo', size => 20 } ]); + my $index = $table->add_index(name => 'myindex', fields => [ { name => 'foo', prefix_length => 20 } ]); my ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index); is($def, "CREATE INDEX myindex on foobar (foo)", 'index created'); ($def) = SQL::Translator::Producer::PostgreSQL::create_index($index, $quote); From d064562a9ff1f0f227a6bcd0ec8c6242454d6d61 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Mon, 19 Jun 2023 07:54:33 +0100 Subject: [PATCH 10/20] Enable other options in index field names --- lib/SQL/Translator/Producer/MySQL.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm index 8e44ea441..68e76bc85 100644 --- a/lib/SQL/Translator/Producer/MySQL.pm +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -685,7 +685,7 @@ sub create_index )) : '', '(' . join( ', ', map { - ref $_ ? $generator->quote($_->{name}) . "($_->{prefix_length})" : $generator->quote($_) + ref $_ && exists $_->{prefix_length} ? $generator->quote($_->{name}) . "($_->{prefix_length})" : $generator->quote($_) } $index->fields ) . ')' ); } From aff5e8d1dce4f6cb9492cac114d209fb67ee0152 Mon Sep 17 00:00:00 2001 From: Veesh Goldman Date: Mon, 19 Jun 2023 20:44:35 +0000 Subject: [PATCH 11/20] chore: rollback the fields -> field_names changes in the producers --- lib/SQL/Translator/Generator/DDL/SQLServer.pm | 2 +- lib/SQL/Translator/Producer/DB2.pm | 2 +- lib/SQL/Translator/Producer/GraphViz.pm | 2 +- lib/SQL/Translator/Producer/HTML.pm | 2 +- lib/SQL/Translator/Producer/Oracle.pm | 4 ++-- lib/SQL/Translator/Producer/POD.pm | 2 +- lib/SQL/Translator/Producer/PostgreSQL.pm | 2 +- lib/SQL/Translator/Producer/SQLite.pm | 2 +- lib/SQL/Translator/Producer/Sybase.pm | 2 +- lib/SQL/Translator/Producer/YAML.pm | 2 +- 10 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/SQL/Translator/Generator/DDL/SQLServer.pm b/lib/SQL/Translator/Generator/DDL/SQLServer.pm index 3fd681d75..72212295b 100644 --- a/lib/SQL/Translator/Generator/DDL/SQLServer.pm +++ b/lib/SQL/Translator/Generator/DDL/SQLServer.pm @@ -67,7 +67,7 @@ sub index { 'CREATE INDEX ' . $_[0]->quote($_[1]->name || $_[1]->table->name . '_idx') . ' ON ' . $_[0]->quote($_[1]->table->name) . - ' (' . join( ', ', map $_[0]->quote($_), $_[1]->field_names ) . ');' + ' (' . join( ', ', map $_[0]->quote($_), $_[1]->fields ) . ');' } sub unique_constraint_single { diff --git a/lib/SQL/Translator/Producer/DB2.pm b/lib/SQL/Translator/Producer/DB2.pm index 83463cc33..3070bbfe0 100644 --- a/lib/SQL/Translator/Producer/DB2.pm +++ b/lib/SQL/Translator/Producer/DB2.pm @@ -310,7 +310,7 @@ sub create_index $index->type() =~ /^UNIQUE$/i ? 'UNIQUE' : '', $index->name, $index->table->name, - join(', ', $index->field_names) ); + join(', ', $index->fields) ); return $out; } diff --git a/lib/SQL/Translator/Producer/GraphViz.pm b/lib/SQL/Translator/Producer/GraphViz.pm index bfe36d53b..17109ec42 100644 --- a/lib/SQL/Translator/Producer/GraphViz.pm +++ b/lib/SQL/Translator/Producer/GraphViz.pm @@ -465,7 +465,7 @@ sub produce { ? $index->name . ':' : () , - join (', ', $index->field_names_with_lengths), + join (', ', $index->fields), ($index->type eq 'UNIQUE') ? '[U]' : (), ); } diff --git a/lib/SQL/Translator/Producer/HTML.pm b/lib/SQL/Translator/Producer/HTML.pm index 07a1b90fe..e970df185 100644 --- a/lib/SQL/Translator/Producer/HTML.pm +++ b/lib/SQL/Translator/Producer/HTML.pm @@ -181,7 +181,7 @@ sub produce { for my $index ( @indices ) { my $name = $index->name || ''; - my $fields = join( ', ', $index->field_names_with_lengths ) || ''; + my $fields = join( ', ', $index->fields ) || ''; push @html, $q->Tr({ -class => 'IndexCell' }, diff --git a/lib/SQL/Translator/Producer/Oracle.pm b/lib/SQL/Translator/Producer/Oracle.pm index e5f76240e..7c51e2bb7 100644 --- a/lib/SQL/Translator/Producer/Oracle.pm +++ b/lib/SQL/Translator/Producer/Oracle.pm @@ -329,7 +329,7 @@ sub create_table { for my $index ( $table->get_indices ) { my $index_name = $index->name || ''; my $index_type = $index->type || NORMAL; - my @fields = map { quote($_, $qf) } $index->field_names; + my @fields = map { quote($_, $qf) } $index->fields; next unless @fields; debug("ORA: Creating $index_type index on fields (" . join(', ', @fields) . ") named $index_name"); my @index_options; @@ -677,7 +677,7 @@ sub create_index { $index_name ? quote($index_name, $qf): '', 'ON', quote($index->table, $qt), - '(' . join( ', ', map { quote($_, $qf) } $index->field_names ) . ")$index_options" + '(' . join( ', ', map { quote($_, $qf) } $index->fields ) . ")$index_options" ); } diff --git a/lib/SQL/Translator/Producer/POD.pm b/lib/SQL/Translator/Producer/POD.pm index 58645c922..2bd92be23 100644 --- a/lib/SQL/Translator/Producer/POD.pm +++ b/lib/SQL/Translator/Producer/POD.pm @@ -71,7 +71,7 @@ sub produce { for my $index ( @indices ) { $pod .= "=head4 " . $index->type . "\n\n=over 4\n\n"; $pod .= "=item * Fields = " . - join(', ', $index->field_names_with_lengths ) . "\n\n"; + join(', ', $index->fields ) . "\n\n"; $pod .= "=back\n\n"; } } diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index e76b235a0..34d1ad6a1 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/lib/SQL/Translator/Producer/PostgreSQL.pm @@ -619,7 +619,7 @@ sub create_geometry_constraints { || join('_', $table_name, 'idx', ++$index_name{ $table_name }); my $type = $index->type || NORMAL; - my @fields = $index->field_names; + my @fields = $index->fields; return unless @fields; my %index_extras; diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm index 3589eeda9..860a7186b 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -299,7 +299,7 @@ sub create_index my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : ''; # strip any field size qualifiers as SQLite doesn't like these - my @fields = map { s/\(\d+\)$//; _generator()->quote($_) } $index->field_names; + my @fields = map { s/\(\d+\)$//; _generator()->quote($_) } $index->fields; $index_table_name = _generator()->quote($index_table_name); warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN; my $index_def = diff --git a/lib/SQL/Translator/Producer/Sybase.pm b/lib/SQL/Translator/Producer/Sybase.pm index bb8b47093..0080c47f6 100644 --- a/lib/SQL/Translator/Producer/Sybase.pm +++ b/lib/SQL/Translator/Producer/Sybase.pm @@ -286,7 +286,7 @@ sub produce { push @index_defs, 'CREATE INDEX ' . $index->name . " ON $table_name (". - join( ', ',$index->field_names ) . ")"; + join( ', ', $index->fields ) . ")"; } my $drop_statement = $add_drop_table diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index 28fc074a8..a296b19c7 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -173,7 +173,7 @@ sub view_index { return { 'name' => scalar $index->name, 'type' => scalar $index->type, - 'fields' => [ $index->fields ], + 'fields' => [ map { ref($_) ? $_->name : $_ } $index->fields ], 'options' => scalar $index->options, keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; From cbd2d4fbd1e98cc20484343a9f48bc52035b89a7 Mon Sep 17 00:00:00 2001 From: Veesh Goldman Date: Wed, 21 Jun 2023 20:26:53 +0000 Subject: [PATCH 12/20] feat(IndexField): upgrade all index fields to use a new IndexField object --- lib/SQL/Translator/Role/ListAttr.pm | 5 +- lib/SQL/Translator/Schema/Index.pm | 70 ++++++-------------- lib/SQL/Translator/Schema/IndexField.pm | 87 +++++++++++++++++++++++++ lib/SQL/Translator/Utils.pm | 13 +--- 4 files changed, 109 insertions(+), 66 deletions(-) create mode 100644 lib/SQL/Translator/Schema/IndexField.pm diff --git a/lib/SQL/Translator/Role/ListAttr.pm b/lib/SQL/Translator/Role/ListAttr.pm index 84b64f0b9..fd4070031 100644 --- a/lib/SQL/Translator/Role/ListAttr.pm +++ b/lib/SQL/Translator/Role/ListAttr.pm @@ -22,7 +22,7 @@ attributes. =cut -use SQL::Translator::Utils qw(parse_list_arg ex2err uniq uniq_keys); +use SQL::Translator::Utils qw(parse_list_arg ex2err uniq); use Sub::Quote qw(quote_sub); use Package::Variant ( @@ -83,11 +83,8 @@ sub make_variant { my $may_throw = delete $arguments{may_throw}; my $undef_if_empty = delete $arguments{undef_if_empty}; my $append = delete $arguments{append}; - my $uniq_keys = delete $arguments{uniq_keys}; my $coerce = delete $arguments{uniq} ? sub { [ uniq @{parse_list_arg($_[0])} ] } - : $uniq_keys - ? sub { [ uniq_keys $uniq_keys, @{parse_list_arg($_[0])} ] } : \&parse_list_arg; has($name => ( diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index fc6ff3543..d337e7783 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -27,7 +27,8 @@ Primary and unique keys are table constraints, not indices. use Moo; use SQL::Translator::Schema::Constants; -use SQL::Translator::Utils qw(ex2err throw); +use SQL::Translator::Schema::IndexField; +use SQL::Translator::Utils qw(ex2err throw parse_list_arg uniq); use SQL::Translator::Role::ListAttr; use SQL::Translator::Types qw(schema_obj enum); use Sub::Quote qw(quote_sub); @@ -61,17 +62,18 @@ names and keep them in order by the first occurrence of a field name. $index->fields( 'id, name' ); $index->fields( [ 'id', 'name' ] ); $index->fields( qw[ id name ] ); + $index->fields(id => { name => 'name', order_by => 'ASC NULLS LAST' }); my @fields = $index->fields; -The length of an index can be specified as follows (only has any effect -with a MySQL database): - - $index->fields( 'id', { name => 'firstname', prefix_length => 15 } ); - =cut -with ListAttr fields => ( uniq_keys => 'name' ); + +with ListAttr fields => ( + coerce => sub { + [ uniq map SQL::Translator::Schema::IndexField->new($_), @{parse_list_arg($_[0])}] + } +); sub is_valid { @@ -112,33 +114,6 @@ has name => ( default => quote_sub(q{ '' }), ); -=head2 field_names - -Return just the index field names for the case when we don't care whether -the "prefix_length" is specified or not. - -=cut - -sub field_names { - my ($self) = @_; - - return ( map { ref $_ ? $_->{name} : $_ } ($self->fields) ); -} - -=head2 fields_with_lengths - -Return the index field names with the prefix_length appended if set. - -=cut - -sub fields_with_lengths { - my ($self) = @_; - - print STDERR Data::Dumper::Dumper($self->fields); - return ( map { ref $_ ? "$_->{name}($_->{prefix_length})" : $_ } - ($self->fields) ); -} - =head2 options Get or set the index's options (e.g., "using" or "where" for PG). Returns @@ -206,10 +181,8 @@ around equals => sub { return 0 unless $self->$orig($other); unless ($ignore_index_names) { - my $self_first = ref $self->fields->[0] ? $self->fields->[0]->{name} : $self->fields->[0] || ''; - my $other_first = ref $other->fields->[0] ? $other->fields->[0]->{name} : $other->fields->[0] || ''; - unless ((!$self->name && ($other->name eq $other_first)) || - (!$other->name && ($self->name eq $self_first))) { + unless ((!$self->name && ($other->name eq $other->fields->[0]->name)) || + (!$other->name && ($self->name eq $self->fields->[0]))) { return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; } } @@ -217,20 +190,15 @@ around equals => sub { return 0 unless $self->type eq $other->type; # Check fields, regardless of order - my %otherFields = (); # create a hash of the other fields - foreach my $otherField ($other->fields) { - my $name = ref $otherField ? $otherField->{name} : $otherField; - $name = uc($name) if $case_insensitive; - $otherFields{$name} = ref $otherField ? $otherField->{prefix_length} : -1; # -1 == no length. Easier comparison. - } - foreach my $selfField ($self->fields) { # check for self fields in hash - my ($name, $size) = ref $selfField ? ($selfField->{name}, $selfField->{prefix_length}) : ($selfField, -1); - $name = uc($name) if $case_insensitive; - return 0 unless exists $otherFields{$name} && $otherFields{$name} == $size; - delete $otherFields{$name}; + # TODO - fix up field comparison!! + my $get_name = sub { return $case_insensitive ? uc(shift->name) : shift->name; }; + my @otherFields = sort map +{ item => $_, key => $get_name->($_) }, $other->fields; + my @selfFields = sort map +{ item => $_, key => $get_name->($_) }, $self->fields; + return 0 unless @otherFields == @selfFields; + for my $idx (0..$#selfFields) { + return 0 unless $selfFields[$idx]{key} eq $otherFields[$idx]{key}; + return 0 unless $self->_compare_objects(scalar $selfFields[$idx]{item}->extra, scalar $otherFields[$idx]{item}->extra); } - # Check all other fields were accounted for - return 0 unless keys %otherFields == 0; return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options); return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra); diff --git a/lib/SQL/Translator/Schema/IndexField.pm b/lib/SQL/Translator/Schema/IndexField.pm new file mode 100644 index 000000000..0a8110b5f --- /dev/null +++ b/lib/SQL/Translator/Schema/IndexField.pm @@ -0,0 +1,87 @@ +package SQL::Translator::Schema::IndexField; + +=pod + +=head1 NAME + +SQL::Translator::Schema::IndexField - SQL::Translator index field object + +=head1 DESCRIPTION + +C is the index field object. + +Different databases allow for different options on index fields. Those are supported through here + +=head1 METHODS + +=cut +use Moo; + +extends 'SQL::Translator::Schema::Object'; + +use overload '""' => sub { shift->name }; + +=head2 new + +Object constructor. + + my $schema = SQL::Translator::Schema::IndexField->new; + +=head2 name + +The name of the index. The object stringifies to this. In addition, you can simply pass +a string to the constructor to only set this attribute. + +=head2 extra + +All options for the field are stored under the extra hash. The constructor will collect +them for you if passed in straight. In addition, an accessor is provided for all supported options + +Currently supported options: + +=over 4 + +=item prefix_length + +Supported by MySQL. Indicates that only N characters of the column are indexed. + +=back + +=cut + +around BUILDARGS => sub { + my ($orig, $self, @args) = @_; + if (@args == 1 && !ref $args[0]) { + @args = (name => $args[0]); + } + my $args = $self->$orig(@args); + my $extra = delete $args->{extra} || {}; + my $name = delete $args->{name}; + return { + name => $name, + extra => { + %$extra, + %$args + } + } +}; + +has name => ( + is => 'rw', + required => 1, +); + +has extra => ( + is => 'rw', + default => sub { {} }, +); + +=pod + +=head1 AUTHOR + +Veesh Goldman Eveesh@cpan.orgE. + +=cut + +9007 diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm index 761e703c0..6f551fd63 100644 --- a/lib/SQL/Translator/Utils.pm +++ b/lib/SQL/Translator/Utils.pm @@ -15,7 +15,7 @@ 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 batch_alter_table_statements - uniq uniq_keys throw ex2err carp_ro + uniq throw ex2err carp_ro normalize_quote_options ); use constant COLLISION_TAG_LENGTH => 8; @@ -131,7 +131,7 @@ sub parse_list_arg { # # This protects stringification of references. # - if ( @$list && grep { ref $_ } @$list ) { + if ( @$list && ref $list->[0] ) { return $list; } # @@ -376,15 +376,6 @@ sub uniq { ) } @_; } -sub uniq_keys { - my $key = shift; - my %seen; - grep { - my $name = ref $_ ? $_->{$key} : $_; - not ( $seen{$name}++ ); - } @_; -} - sub throw { die SQL::Translator::Utils::Error->new($_[0]); } From f08bf6a45830db633462997213bbfdeae7f62671 Mon Sep 17 00:00:00 2001 From: Veesh Goldman Date: Wed, 21 Jun 2023 20:27:23 +0000 Subject: [PATCH 13/20] feat(MySQL): upgrade producer to support prefix_length w/ new objects --- lib/SQL/Translator/Producer/MySQL.pm | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm index 68e76bc85..cb969f448 100644 --- a/lib/SQL/Translator/Producer/MySQL.pm +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -674,6 +674,15 @@ sub create_index my ( $index, $options ) = @_; my $generator = _generator($options); + my @fields; + for my $field ($index->fields) { + my $name = $generator->quote($field->name); + if (my $len = $field->extra->{prefix_length}) { + $name .= "($len)"; + } + push @fields, $name; + + } return join( ' ', map { $_ || () } @@ -684,9 +693,7 @@ sub create_index $options->{max_id_length} || $DEFAULT_MAX_ID_LENGTH )) : '', - '(' . join( ', ', map { - ref $_ && exists $_->{prefix_length} ? $generator->quote($_->{name}) . "($_->{prefix_length})" : $generator->quote($_) - } $index->fields ) . ')' + '(' . join( ', ', @fields) . ')' ); } From e267a95e7c422819a8418ec02fe7a7d1d977ee58 Mon Sep 17 00:00:00 2001 From: Veesh Goldman Date: Wed, 21 Jun 2023 20:37:23 +0000 Subject: [PATCH 14/20] fix: oops, actually put in the sort routine :face_palm: --- lib/SQL/Translator/Schema/Index.pm | 7 +++---- t/13schema.t | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index d337e7783..c929ec081 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -182,7 +182,7 @@ around equals => sub { unless ($ignore_index_names) { unless ((!$self->name && ($other->name eq $other->fields->[0]->name)) || - (!$other->name && ($self->name eq $self->fields->[0]))) { + (!$other->name && ($self->name eq $self->fields->[0]->name))) { return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; } } @@ -190,10 +190,9 @@ around equals => sub { return 0 unless $self->type eq $other->type; # Check fields, regardless of order - # TODO - fix up field comparison!! my $get_name = sub { return $case_insensitive ? uc(shift->name) : shift->name; }; - my @otherFields = sort map +{ item => $_, key => $get_name->($_) }, $other->fields; - my @selfFields = sort map +{ item => $_, key => $get_name->($_) }, $self->fields; + my @otherFields = sort { $a->{key} cmp $b->{key} } map +{ item => $_, key => $get_name->($_) }, $other->fields; + my @selfFields = sort { $a->{key} cmp $b->{key} } map +{ item => $_, key => $get_name->($_) }, $self->fields; return 0 unless @otherFields == @selfFields; for my $idx (0..$#selfFields) { return 0 unless $selfFields[$idx]{key} eq $otherFields[$idx]{key}; diff --git a/t/13schema.t b/t/13schema.t index f95f3a5a2..71dc7d914 100644 --- a/t/13schema.t +++ b/t/13schema.t @@ -280,7 +280,7 @@ require_ok( 'SQL::Translator::Schema' ); # Check that 2 indexes are equal, if one doesn't have a name, and the # other has a name that is the same as the first field my $index8 = SQL::Translator::Schema::Index->new( fields => [qw/foo age/] ); - ok( $index8->equals($index6), "Compare 2 indexes, one without name" ); + ok( $index8->equals($index6, 0, 0, 1), "Compare 2 indexes, one without name" ); my $indices = $person_table->get_indices; is( scalar @$indices, 3, 'Two indices' ); From 1a0a3143f494d78efe2e0f9905f07649f27401af Mon Sep 17 00:00:00 2001 From: Veesh Goldman Date: Wed, 21 Jun 2023 20:55:57 +0000 Subject: [PATCH 15/20] fix(parse_list_arg): don't stringify the tings! --- lib/SQL/Translator/Schema/Index.pm | 9 +++++++-- lib/SQL/Translator/Utils.pm | 3 ++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index c929ec081..81f3b5e2e 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -28,7 +28,7 @@ Primary and unique keys are table constraints, not indices. use Moo; use SQL::Translator::Schema::Constants; use SQL::Translator::Schema::IndexField; -use SQL::Translator::Utils qw(ex2err throw parse_list_arg uniq); +use SQL::Translator::Utils qw(ex2err throw parse_list_arg); use SQL::Translator::Role::ListAttr; use SQL::Translator::Types qw(schema_obj enum); use Sub::Quote qw(quote_sub); @@ -71,7 +71,12 @@ names and keep them in order by the first occurrence of a field name. with ListAttr fields => ( coerce => sub { - [ uniq map SQL::Translator::Schema::IndexField->new($_), @{parse_list_arg($_[0])}] + my %seen; + return [ + grep !$seen{$_->name}++, + map SQL::Translator::Schema::IndexField->new($_), + @{parse_list_arg($_[0])} + ] } ); diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm index 6f551fd63..57dc52aaf 100644 --- a/lib/SQL/Translator/Utils.pm +++ b/lib/SQL/Translator/Utils.pm @@ -7,6 +7,7 @@ use File::Spec; use Scalar::Util qw(blessed); use Try::Tiny; use Carp qw(carp croak); +use List::Util qw(any); our $VERSION = '1.63'; @@ -131,7 +132,7 @@ sub parse_list_arg { # # This protects stringification of references. # - if ( @$list && ref $list->[0] ) { + if (any { ref $_ } @$list ) { return $list; } # From a26cff073c53d23170201bcfe0437d04bfbce24e Mon Sep 17 00:00:00 2001 From: Veesh Goldman Date: Wed, 21 Jun 2023 21:04:55 +0000 Subject: [PATCH 16/20] fix: handle weird YAML double objecting --- lib/SQL/Translator/Schema/IndexField.pm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lib/SQL/Translator/Schema/IndexField.pm b/lib/SQL/Translator/Schema/IndexField.pm index 0a8110b5f..073c5be86 100644 --- a/lib/SQL/Translator/Schema/IndexField.pm +++ b/lib/SQL/Translator/Schema/IndexField.pm @@ -54,6 +54,11 @@ around BUILDARGS => sub { if (@args == 1 && !ref $args[0]) { @args = (name => $args[0]); } + # there are some weird pathological cases where we get an object passed in rather than a + # hashref. We'll just clone it + if (ref $args[0] eq $self) { + return { %{$args[0]} } + } my $args = $self->$orig(@args); my $extra = delete $args->{extra} || {}; my $name = delete $args->{name}; From bfc7565e884e646ee93378ec2428e77bea2c0164 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Sat, 22 Jul 2023 18:37:27 +0100 Subject: [PATCH 17/20] Write index extra properties in YAML producer --- lib/SQL/Translator/Producer/YAML.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index a296b19c7..e9aa4938f 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -173,7 +173,8 @@ sub view_index { return { 'name' => scalar $index->name, 'type' => scalar $index->type, - 'fields' => [ map { ref($_) ? $_->name : $_ } $index->fields ], + # If the index has extra properties, make sure these are written too + 'fields' => [ map { ref($_) && $_->extra ? { name => $_->name, %{$_->extra} } : $_ } $index->fields ], 'options' => scalar $index->options, keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; From 905fa34bd3204aba84fafdb2ba09c726f9e0d642 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Sat, 22 Jul 2023 18:47:05 +0100 Subject: [PATCH 18/20] Fix failing test --- lib/SQL/Translator/Producer/YAML.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index e9aa4938f..79c258af4 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -174,7 +174,7 @@ sub view_index { 'name' => scalar $index->name, 'type' => scalar $index->type, # If the index has extra properties, make sure these are written too - 'fields' => [ map { ref($_) && $_->extra ? { name => $_->name, %{$_->extra} } : $_ } $index->fields ], + 'fields' => [ map { ref($_) && $_->extra && %{$_->extra} ? { name => $_->name, %{$_->extra} } : "$_" } $index->fields ], 'options' => scalar $index->options, keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; From 79bfc70b755dd8c6aca2646286c5b99f99dacbb7 Mon Sep 17 00:00:00 2001 From: Andy Beverley Date: Sat, 22 Jul 2023 18:49:30 +0100 Subject: [PATCH 19/20] Fix failing lint test --- lib/SQL/Translator/Schema/IndexField.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/SQL/Translator/Schema/IndexField.pm b/lib/SQL/Translator/Schema/IndexField.pm index 073c5be86..acad6c3f2 100644 --- a/lib/SQL/Translator/Schema/IndexField.pm +++ b/lib/SQL/Translator/Schema/IndexField.pm @@ -14,7 +14,7 @@ Different databases allow for different options on index fields. Those are suppo =head1 METHODS -=cut +=cut use Moo; extends 'SQL::Translator::Schema::Object'; From 28d3d2f08ca024150d044347d958fe5c1f0a5573 Mon Sep 17 00:00:00 2001 From: Veesh Goldman Date: Sat, 25 Nov 2023 21:55:16 +0000 Subject: [PATCH 20/20] chore: finish up here --- lib/SQL/Translator/Producer/JSON.pm | 2 +- lib/SQL/Translator/Producer/YAML.pm | 2 +- t/13schema.t | 703 +++++++++++++++++----------- 3 files changed, 421 insertions(+), 286 deletions(-) diff --git a/lib/SQL/Translator/Producer/JSON.pm b/lib/SQL/Translator/Producer/JSON.pm index e03f26dd0..b3eb01ec4 100644 --- a/lib/SQL/Translator/Producer/JSON.pm +++ b/lib/SQL/Translator/Producer/JSON.pm @@ -176,7 +176,7 @@ sub view_index { return { 'name' => scalar $index->name, 'type' => scalar $index->type, - 'fields' => scalar $index->fields, + 'fields' => [ map { ref($_) && $_->extra && keys %{$_->extra} ? { name => $_->name, %{$_->extra} } : "$_" } $index->fields ], 'options' => scalar $index->options, keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index 79c258af4..efcbd574c 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -174,7 +174,7 @@ sub view_index { 'name' => scalar $index->name, 'type' => scalar $index->type, # If the index has extra properties, make sure these are written too - 'fields' => [ map { ref($_) && $_->extra && %{$_->extra} ? { name => $_->name, %{$_->extra} } : "$_" } $index->fields ], + 'fields' => [ map { ref($_) && $_->extra && keys %{$_->extra} ? { name => $_->name, %{$_->extra} } : "$_" } $index->fields ], 'options' => scalar $index->options, keys %{$index->extra} ? ('extra' => { $index->extra } ) : (), }; diff --git a/t/13schema.t b/t/13schema.t index 71dc7d914..230a84d2e 100644 --- a/t/13schema.t +++ b/t/13schema.t @@ -9,25 +9,25 @@ use Test::More; use Test::Exception; use SQL::Translator::Schema::Constants; -require_ok( 'SQL::Translator' ); -require_ok( 'SQL::Translator::Schema' ); +require_ok('SQL::Translator'); +require_ok('SQL::Translator::Schema'); { # # Schema # my $schema = SQL::Translator::Schema->new( - name => 'foo', + name => 'foo', database => 'MySQL', ); isa_ok( $schema, 'SQL::Translator::Schema' ); - is( $schema->name, 'foo', 'Schema name is "foo"' ); + is( $schema->name, 'foo', 'Schema name is "foo"' ); is( $schema->name('bar'), 'bar', 'Schema name changed to "bar"' ); is( $schema->database, 'MySQL', 'Schema database is "MySQL"' ); - is( $schema->database('PostgreSQL'), 'PostgreSQL', - 'Schema database changed to "PostgreSQL"' ); + is( $schema->database('PostgreSQL'), + 'PostgreSQL', 'Schema database changed to "PostgreSQL"' ); is( $schema->is_valid, undef, 'Schema not valid...' ); like( $schema->error, qr/no tables/i, '...because there are no tables' ); @@ -35,55 +35,75 @@ require_ok( 'SQL::Translator::Schema' ); # # $schema->add_* # - my $foo_table = $schema->add_table(name => 'foo') or warn $schema->error; + my $foo_table = $schema->add_table( name => 'foo' ) or warn $schema->error; isa_ok( $foo_table, 'SQL::Translator::Schema::Table', 'Table "foo"' ); - my $bar_table = SQL::Translator::Schema::Table->new( name => 'bar' ) or - warn SQL::Translator::Schema::Table->error; - $bar_table = $schema->add_table( $bar_table ); + my $bar_table = SQL::Translator::Schema::Table->new( name => 'bar' ) + or warn SQL::Translator::Schema::Table->error; + $bar_table = $schema->add_table($bar_table); isa_ok( $bar_table, 'SQL::Translator::Schema::Table', 'Table "bar"' ); is( $bar_table->name, 'bar', 'Add table "bar"' ); - $schema = $bar_table->schema( $schema ); + $schema = $bar_table->schema($schema); isa_ok( $schema, 'SQL::Translator::Schema', 'Schema' ); - is( $bar_table->name('foo'), undef, - q[Can't change name of table "bar" to "foo"...]); - like( $bar_table->error, qr/can't use table name/i, - q[...because "foo" exists] ); + is( $bar_table->name('foo'), + undef, q[Can't change name of table "bar" to "foo"...] ); + like( + $bar_table->error, + qr/can't use table name/i, + q[...because "foo" exists] + ); - my $redundant_table = $schema->add_table(name => 'foo'); + my $redundant_table = $schema->add_table( name => 'foo' ); is( $redundant_table, undef, qq[Can't create another "foo" table...] ); - like( $schema->error, qr/can't use table name/i, - '... because "foo" exists' ); + like( + $schema->error, + qr/can't use table name/i, + '... because "foo" exists' + ); - $redundant_table = $schema->add_table(name => ''); + $redundant_table = $schema->add_table( name => '' ); is( $redundant_table, undef, qq[Can't add an anonymous table...] ); - like( $schema->error, qr/No table name/i, - '... because it has no name ' ); + like( $schema->error, qr/No table name/i, '... because it has no name ' ); - $redundant_table = SQL::Translator::Schema::Table->new(name => ''); + $redundant_table = SQL::Translator::Schema::Table->new( name => '' ); is( $redundant_table, undef, qq[Can't create an anonymous table] ); - like( SQL::Translator::Schema::Table->error, qr/No table name/i, - '... because it has no name ' ); + like( + SQL::Translator::Schema::Table->error, + qr/No table name/i, + '... because it has no name ' + ); # # $schema-> drop_table # - my $dropped_table = $schema->drop_table($foo_table->name, cascade => 1); - isa_ok($dropped_table, 'SQL::Translator::Schema::Table', 'Dropped table "foo"' ); + my $dropped_table = $schema->drop_table( $foo_table->name, cascade => 1 ); + isa_ok( + $dropped_table, + 'SQL::Translator::Schema::Table', + 'Dropped table "foo"' + ); $schema->add_table($foo_table); - my $dropped_table2 = $schema->drop_table($foo_table, cascade => 1); - isa_ok($dropped_table2, 'SQL::Translator::Schema::Table', 'Dropped table "foo" by object' ); - my $dropped_table3 = $schema->drop_table($foo_table->name, cascade => 1); - like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant table "foo"] ); + my $dropped_table2 = $schema->drop_table( $foo_table, cascade => 1 ); + isa_ok( + $dropped_table2, + 'SQL::Translator::Schema::Table', + 'Dropped table "foo" by object' + ); + my $dropped_table3 = $schema->drop_table( $foo_table->name, cascade => 1 ); + like( + $schema->error, + qr/doesn't exist/, + qq[Can't drop non-existant table "foo"] + ); $schema->add_table($foo_table); # # Table default new # - is( $foo_table->name, 'foo', 'Table name is "foo"' ); - is( "$foo_table", 'foo', 'Table stringifies to "foo"' ); + is( $foo_table->name, 'foo', 'Table name is "foo"' ); + is( "$foo_table", 'foo', 'Table stringifies to "foo"' ); is( $foo_table->is_valid, undef, 'Table "foo" is not yet valid' ); my $fields = $foo_table->get_fields; @@ -99,88 +119,105 @@ require_ok( 'SQL::Translator::Schema' ); name => 'person', comments => 'foo', ); - is( $person_table->name, 'person', 'Table name is "person"' ); - is( $person_table->is_valid, undef, 'Table is not yet valid' ); - is( $person_table->comments, 'foo', 'Comments = "foo"' ); - is( join(',', $person_table->comments('bar')), 'foo,bar', - 'Table comments = "foo,bar"' ); + is( $person_table->name, 'person', 'Table name is "person"' ); + is( $person_table->is_valid, undef, 'Table is not yet valid' ); + is( $person_table->comments, 'foo', 'Comments = "foo"' ); + is( join( ',', $person_table->comments('bar') ), + 'foo,bar', 'Table comments = "foo,bar"' ); is( $person_table->comments, "foo\nbar", 'Table comments = "foo,bar"' ); # # Field default new # - my $f1 = $person_table->add_field(name => 'foo') or - warn $person_table->error; + my $f1 = $person_table->add_field( name => 'foo' ) + or warn $person_table->error; isa_ok( $f1, 'SQL::Translator::Schema::Field', 'Field' ); - is( $f1->name, 'foo', 'Field name is "foo"' ); - is( $f1->full_name, 'person.foo', 'Field full_name is "person.foo"' ); - is( "$f1", 'foo', 'Field stringifies to "foo"' ); - is( $f1->data_type, '', 'Field data type is blank' ); - is( $f1->size, 0, 'Field size is "0"' ); - is( $f1->is_primary_key, '0', 'Field is_primary_key is false' ); - is( $f1->is_nullable, 1, 'Field can be NULL' ); - is( $f1->default_value, undef, 'Field default is undefined' ); - is( $f1->comments, '', 'No comments' ); - is( $f1->table, 'person', 'Field table is person' ); + is( $f1->name, 'foo', 'Field name is "foo"' ); + is( $f1->full_name, 'person.foo', 'Field full_name is "person.foo"' ); + is( "$f1", 'foo', 'Field stringifies to "foo"' ); + is( $f1->data_type, '', 'Field data type is blank' ); + is( $f1->size, 0, 'Field size is "0"' ); + is( $f1->is_primary_key, '0', 'Field is_primary_key is false' ); + is( $f1->is_nullable, 1, 'Field can be NULL' ); + is( $f1->default_value, undef, 'Field default is undefined' ); + is( $f1->comments, '', 'No comments' ); + is( $f1->table, 'person', 'Field table is person' ); is( $f1->schema->database, 'PostgreSQL', 'Field schema shortcut works' ); - my $f2 = SQL::Translator::Schema::Field->new ( + my $f2 = SQL::Translator::Schema::Field->new( name => 'f2', comments => 'foo', ) or warn SQL::Translator::Schema::Field->error; - $f2 = $person_table->add_field( $f2 ); + $f2 = $person_table->add_field($f2); isa_ok( $f1, 'SQL::Translator::Schema::Field', 'f2' ); - is( $f2->name, 'f2', 'Add field "f2"' ); - is( $f2->is_nullable(0), 0, 'Field cannot be NULL' ); - is( $f2->is_nullable(''), 0, 'Field cannot be NULL' ); - is( $f2->is_nullable('0'), 0, 'Field cannot be NULL' ); - is( $f2->default_value(''), '', 'Field default is empty string' ); - is( $f2->comments, 'foo', 'Field comment = "foo"' ); - is( join(',', $f2->comments('bar')), 'foo,bar', - 'Field comment = "foo,bar"' ); + is( $f2->name, 'f2', 'Add field "f2"' ); + is( $f2->is_nullable(0), 0, 'Field cannot be NULL' ); + is( $f2->is_nullable(''), 0, 'Field cannot be NULL' ); + is( $f2->is_nullable('0'), 0, 'Field cannot be NULL' ); + is( $f2->default_value(''), '', 'Field default is empty string' ); + is( $f2->comments, 'foo', 'Field comment = "foo"' ); + is( join( ',', $f2->comments('bar') ), + 'foo,bar', 'Field comment = "foo,bar"' ); is( $f2->comments, "foo\nbar", 'Field comment = "foo,bar"' ); - $person_table = $f2->table( $person_table ); + $person_table = $f2->table($person_table); isa_ok( $person_table, 'SQL::Translator::Schema::Table', 'person_table' ); is( $f2->name('foo'), undef, q[Can't set field name of "f2" to "foo"...] ); like( $f2->error, qr/can't use field name/i, '...because name exists' ); - my $redundant_field = $person_table->add_field(name => 'f2'); + my $redundant_field = $person_table->add_field( name => 'f2' ); is( $redundant_field, undef, qq[Didn't create another "f2" field...] ); - like( $person_table->error, qr/can't use field/i, - '... because it exists' ); + like( $person_table->error, qr/can't use field/i, '... because it exists' ); - $redundant_field = $person_table->add_field(name => ''); + $redundant_field = $person_table->add_field( name => '' ); is( $redundant_field, undef, qq[Didn't add a "" field...] ); - like( $person_table->error, qr/No field name/i, - '... because it has no name' ); + like( + $person_table->error, + qr/No field name/i, + '... because it has no name' + ); - $redundant_field = SQL::Translator::Schema::Field->new(name => ''); + $redundant_field = SQL::Translator::Schema::Field->new( name => '' ); is( $redundant_field, undef, qq[Didn't create a "" field...] ); - like( SQL::Translator::Schema::Field->error, qr/No field name/i, - '... because it has no name' ); + like( + SQL::Translator::Schema::Field->error, + qr/No field name/i, + '... because it has no name' + ); my @fields = $person_table->get_fields; is( scalar @fields, 2, 'Table "foo" has 2 fields' ); is( $fields[0]->name, 'foo', 'First field is "foo"' ); - is( $fields[1]->name, 'f2', 'Second field is "f2"' ); - is( join(",",$person_table->field_names), 'foo,f2', - 'field_names is "foo,f2"' ); + is( $fields[1]->name, 'f2', 'Second field is "f2"' ); + is( join( ",", $person_table->field_names ), + 'foo,f2', 'field_names is "foo,f2"' ); - my $ci_field = $person_table->get_field('FOO', 'case_insensitive'); + my $ci_field = $person_table->get_field( 'FOO', 'case_insensitive' ); is( $ci_field->name, 'foo', 'Got field case-insensitively' ); # # $table-> drop_field # - my $dropped_field = $person_table->drop_field($f2->name, cascade => 1); - isa_ok($dropped_field, 'SQL::Translator::Schema::Field', 'Dropped field "f2"' ); + my $dropped_field = $person_table->drop_field( $f2->name, cascade => 1 ); + isa_ok( + $dropped_field, + 'SQL::Translator::Schema::Field', + 'Dropped field "f2"' + ); $person_table->add_field($f2); - my $dropped_field2 = $person_table->drop_field($f2, cascade => 1); - isa_ok($dropped_field2, 'SQL::Translator::Schema::Field', 'Dropped field "f2" by object' ); - my $dropped_field3 = $person_table->drop_field($f2->name, cascade => 1); - like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant field "f2"] ); + my $dropped_field2 = $person_table->drop_field( $f2, cascade => 1 ); + isa_ok( + $dropped_field2, + 'SQL::Translator::Schema::Field', + 'Dropped field "f2" by object' + ); + my $dropped_field3 = $person_table->drop_field( $f2->name, cascade => 1 ); + like( + $person_table->error, + qr/doesn't exist/, + qq[Can't drop non-existant field "f2"] + ); $person_table->add_field($f2); @@ -190,30 +227,30 @@ require_ok( 'SQL::Translator::Schema' ); is( $f1->name('person_name'), 'person_name', 'Field name is "person_name"' ); is( $f1->data_type('varchar'), 'varchar', 'Field data type is "varchar"' ); - is( $f1->size('30'), '30', 'Field size is "30"' ); - is( $f1->is_primary_key(0), '0', 'Field is_primary_key is negative' ); + is( $f1->size('30'), '30', 'Field size is "30"' ); + is( $f1->is_primary_key(0), '0', 'Field is_primary_key is negative' ); $f1->extra( foo => 'bar' ); $f1->extra( { baz => 'quux' } ); my %extra = $f1->extra; - is( $extra{'foo'}, 'bar', 'Field extra "foo" is "bar"' ); + is( $extra{'foo'}, 'bar', 'Field extra "foo" is "bar"' ); is( $extra{'baz'}, 'quux', 'Field extra "baz" is "quux"' ); # # New field with args # - my $age = $person_table->add_field( + my $age = $person_table->add_field( name => 'age', data_type => 'float', size => '10,2', ); - is( $age->name, 'age', 'Field name is "age"' ); - is( $age->data_type, 'float', 'Field data type is "float"' ); - is( $age->size, '10,2', 'Field size is "10,2"' ); - is( $age->size(10,2), '10,2', 'Field size still "10,2"' ); - is( $age->size([10,2]), '10,2', 'Field size still "10,2"' ); - is( $age->size(qw[ 10 2 ]), '10,2', 'Field size still "10,2"' ); - is( join(':', $age->size), '10:2', 'Field size returns array' ); + is( $age->name, 'age', 'Field name is "age"' ); + is( $age->data_type, 'float', 'Field data type is "float"' ); + is( $age->size, '10,2', 'Field size is "10,2"' ); + is( $age->size( 10, 2 ), '10,2', 'Field size still "10,2"' ); + is( $age->size( [ 10, 2 ] ), '10,2', 'Field size still "10,2"' ); + is( $age->size(qw[ 10 2 ]), '10,2', 'Field size still "10,2"' ); + is( join( ':', $age->size ), '10:2', 'Field size returns array' ); # # Index @@ -222,56 +259,71 @@ require_ok( 'SQL::Translator::Schema' ); is( scalar @indices, 0, 'No indices' ); like( $person_table->error, qr/no indices/i, 'Error for no indices' ); my $index1 = $person_table->add_index( name => "foo" ) - or warn $person_table->error; + or warn $person_table->error; isa_ok( $index1, 'SQL::Translator::Schema::Index', 'Index' ); is( $index1->name, 'foo', 'Index name is "foo"' ); is( $index1->is_valid, undef, 'Index name is not valid...' ); like( $index1->error, qr/no fields/i, '...because it has no fields' ); - is( join(':', $index1->fields('foo,bar')), 'foo:bar', - 'Index accepts fields'); + is( join( ':', $index1->fields('foo,bar') ), + 'foo:bar', 'Index accepts fields' ); is( $index1->is_valid, undef, 'Index name is not valid...' ); - like( $index1->error, qr/does not exist in table/i, - '...because it used fields not in the table' ); + like( + $index1->error, + qr/does not exist in table/i, + '...because it used fields not in the table' + ); - is( join(':', $index1->fields(qw[foo age])), 'foo:age', - 'Index accepts fields'); + is( join( ':', $index1->fields(qw[foo age]) ), + 'foo:age', 'Index accepts fields' ); is( $index1->is_valid, 1, 'Index name is now valid' ); is( $index1->type, NORMAL, 'Index type is "normal"' ); my $index2 = SQL::Translator::Schema::Index->new( name => "bar" ) - or warn SQL::Translator::Schema::Index->error; - $index2 = $person_table->add_index( $index2 ); + or warn SQL::Translator::Schema::Index->error; + $index2 = $person_table->add_index($index2); isa_ok( $index2, 'SQL::Translator::Schema::Index', 'Index' ); is( $index2->name, 'bar', 'Index name is "bar"' ); - my $index3 = $person_table->add_index( name => "sized", fields => [ { name => 'forename', prefix_length => 15} ] ) - or warn $person_table->error; + my $index3 = $person_table->add_index( + name => "sized", + fields => [ { name => 'forename', prefix_length => 15 } ] + ) or warn $person_table->error; isa_ok( $index3, 'SQL::Translator::Schema::Index', 'Index' ); is( $index3->name, 'sized', 'Index name is "sized"' ); # Test index comparison function. # 2 completely different indexes - ok( !$index3->equals($index2), "2 different indexes return false on equals() function (simple)" ); + ok( !$index3->equals($index2), + "2 different indexes return false on equals() function (simple)" ); # Same indexes with different lengths my $index4 = SQL::Translator::Schema::Index->new( - name => "sized", fields => [ { name => 'forename', prefix_length => 20} ] + name => "sized", + fields => [ { name => 'forename', prefix_length => 20 } ] + ); + ok( !$index3->equals($index4), +"2 different indexes return false on equals() function (index length different)" ); - ok( !$index3->equals($index4), "2 different indexes return false on equals() function (index length different)" ); # Identical indexes with lengths my $index5 = SQL::Translator::Schema::Index->new( - name => "sized", fields => [ { name => 'forename', prefix_length => 15} ] + name => "sized", + fields => [ { name => 'forename', prefix_length => 15 } ] ); - ok( $index3->equals($index5), "2 identical indexes return true on equals() (with index length)" ); + ok( $index3->equals($index5), + "2 identical indexes return true on equals() (with index length)" ); # Identical indexes without lengths - my $index6 = SQL::Translator::Schema::Index->new( name => "foo", fields => [qw/foo age/] ); - ok( $index6->equals($index1), "2 identical indexes return true on equals() (without index length)" ); + my $index6 = SQL::Translator::Schema::Index->new( + name => "foo", + fields => [qw/foo age/] + ); + ok( $index6->equals($index1), + "2 identical indexes return true on equals() (without index length)" ); # Check comparison of index names my $index7 = SQL::Translator::Schema::Index->new( name => "bar" ); @@ -280,25 +332,40 @@ require_ok( 'SQL::Translator::Schema' ); # Check that 2 indexes are equal, if one doesn't have a name, and the # other has a name that is the same as the first field my $index8 = SQL::Translator::Schema::Index->new( fields => [qw/foo age/] ); - ok( $index8->equals($index6, 0, 0, 1), "Compare 2 indexes, one without name" ); + ok( + $index8->equals( $index6, 0, 0, 1 ), + "Compare 2 indexes, one without name" + ); my $indices = $person_table->get_indices; - is( scalar @$indices, 3, 'Two indices' ); - is( $indices->[0]->name, 'foo', '"foo" index' ); - is( $indices->[1]->name, 'bar', '"bar" index' ); + is( scalar @$indices, 3, 'Three indices' ); + is( $indices->[0]->name, 'foo', '"foo" index' ); + is( $indices->[1]->name, 'bar', '"bar" index' ); is( $indices->[2]->name, 'sized', '"sized" index' ); # # $table-> drop_index # - my $dropped_index = $person_table->drop_index($index1->name); - isa_ok($dropped_index, 'SQL::Translator::Schema::Index', 'Dropped index "foo"' ); + my $dropped_index = $person_table->drop_index( $index1->name ); + isa_ok( + $dropped_index, + 'SQL::Translator::Schema::Index', + 'Dropped index "foo"' + ); $person_table->add_index($index1); my $dropped_index2 = $person_table->drop_index($index1); - isa_ok($dropped_index2, 'SQL::Translator::Schema::Index', 'Dropped index "foo" by object' ); - is($dropped_index2->name, $index1->name, 'Dropped correct index "foo"'); - my $dropped_index3 = $person_table->drop_index($index1->name); - like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant index "foo"] ); + isa_ok( + $dropped_index2, + 'SQL::Translator::Schema::Index', + 'Dropped index "foo" by object' + ); + is( $dropped_index2->name, $index1->name, 'Dropped correct index "foo"' ); + my $dropped_index3 = $person_table->drop_index( $index1->name ); + like( + $person_table->error, + qr/doesn't exist/, + qq[Can't drop non-existant index "foo"] + ); $person_table->add_index($index1); @@ -307,51 +374,59 @@ require_ok( 'SQL::Translator::Schema' ); # my @constraints = $person_table->get_constraints; is( scalar @constraints, 0, 'No constraints' ); - like( $person_table->error, qr/no constraints/i, - 'Error for no constraints' ); + like( + $person_table->error, + qr/no constraints/i, + 'Error for no constraints' + ); my $constraint1 = $person_table->add_constraint( name => 'foo' ) - or warn $person_table->error; + or warn $person_table->error; isa_ok( $constraint1, 'SQL::Translator::Schema::Constraint', 'Constraint' ); is( $constraint1->name, 'foo', 'Constraint name is "foo"' ); - $fields = join(',', $constraint1->fields('age') ); + $fields = join( ',', $constraint1->fields('age') ); is( $fields, 'age', 'Constraint field = "age"' ); $fields = $constraint1->fields; - ok( ref $fields[0] && $fields[0]->isa("SQL::Translator::Schema::Field"), - 'Constraint fields returns a SQL::Translator::Schema::Field' ); + ok( + ref $fields[0] && $fields[0]->isa("SQL::Translator::Schema::Field"), + 'Constraint fields returns a SQL::Translator::Schema::Field' + ); - $fields = join(',', $constraint1->fields('age,age') ); + $fields = join( ',', $constraint1->fields('age,age') ); is( $fields, 'age', 'Constraint field = "age"' ); - $fields = join(',', $constraint1->fields('age', 'name') ); + $fields = join( ',', $constraint1->fields( 'age', 'name' ) ); is( $fields, 'age,name', 'Constraint field = "age,name"' ); - $fields = join(',', $constraint1->fields( 'age,name,age' ) ); + $fields = join( ',', $constraint1->fields('age,name,age') ); is( $fields, 'age,name', 'Constraint field = "age,name"' ); - $fields = join(',', $constraint1->fields( 'age, name' ) ); + $fields = join( ',', $constraint1->fields('age, name') ); is( $fields, 'age,name', 'Constraint field = "age,name"' ); - $fields = join(',', $constraint1->fields( [ 'age', 'name' ] ) ); + $fields = join( ',', $constraint1->fields( [ 'age', 'name' ] ) ); is( $fields, 'age,name', 'Constraint field = "age,name"' ); - $fields = join(',', $constraint1->fields( qw[ age name ] ) ); + $fields = join( ',', $constraint1->fields(qw[ age name ]) ); is( $fields, 'age,name', 'Constraint field = "age,name"' ); - $fields = join(',', $constraint1->field_names ); + $fields = join( ',', $constraint1->field_names ); is( $fields, 'age,name', 'Constraint field_names = "age,name"' ); is( $constraint1->match_type, '', 'Constraint match type is empty' ); - is( $constraint1->match_type('foo'), undef, - 'Constraint match type rejects bad arg...' ); - like( $constraint1->error, qr/invalid match type/i, - '...because it is invalid'); - is( $constraint1->match_type('FULL'), 'full', - 'Constraint match type = "full"' ); + is( $constraint1->match_type('foo'), + undef, 'Constraint match type rejects bad arg...' ); + like( + $constraint1->error, + qr/invalid match type/i, + '...because it is invalid' + ); + is( $constraint1->match_type('FULL'), + 'full', 'Constraint match type = "full"' ); my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'bar' ); - $constraint2 = $person_table->add_constraint( $constraint2 ); + $constraint2 = $person_table->add_constraint($constraint2); isa_ok( $constraint2, 'SQL::Translator::Schema::Constraint', 'Constraint' ); is( $constraint2->name, 'bar', 'Constraint name is "bar"' ); @@ -365,21 +440,34 @@ require_ok( 'SQL::Translator::Schema' ); 'Constraint expression is "foo bar"' ); my $constraints = $person_table->get_constraints; - is( scalar @$constraints, 3, 'Three constraints' ); + is( scalar @$constraints, 3, 'Three constraints' ); is( $constraints->[0]->name, 'foo', '"foo" constraint' ); is( $constraints->[1]->name, 'bar', '"bar" constraint' ); # # $table-> drop_constraint # - my $dropped_con = $person_table->drop_constraint($constraint1->name); - isa_ok($dropped_con, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo"' ); + my $dropped_con = $person_table->drop_constraint( $constraint1->name ); + isa_ok( + $dropped_con, + 'SQL::Translator::Schema::Constraint', + 'Dropped constraint "foo"' + ); $person_table->add_constraint($constraint1); my $dropped_con2 = $person_table->drop_constraint($constraint1); - isa_ok($dropped_con2, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo" by object' ); - is($dropped_con2->name, $constraint1->name, 'Dropped correct constraint "foo"'); - my $dropped_con3 = $person_table->drop_constraint($constraint1->name); - like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant constraint "foo"] ); + isa_ok( + $dropped_con2, + 'SQL::Translator::Schema::Constraint', + 'Dropped constraint "foo" by object' + ); + is( $dropped_con2->name, $constraint1->name, + 'Dropped correct constraint "foo"' ); + my $dropped_con3 = $person_table->drop_constraint( $constraint1->name ); + like( + $person_table->error, + qr/doesn't exist/, + qq[Can't drop non-existant constraint "foo"] + ); $person_table->add_constraint($constraint1); @@ -389,28 +477,40 @@ require_ok( 'SQL::Translator::Schema' ); my $view = $schema->add_view( name => 'view1' ) or warn $schema->error; isa_ok( $view, 'SQL::Translator::Schema::View', 'View' ); my $view_sql = 'select * from table'; - is( $view->sql( $view_sql ), $view_sql, 'View SQL is good' ); + is( $view->sql($view_sql), $view_sql, 'View SQL is good' ); - my $view2 = SQL::Translator::Schema::View->new(name => 'view2') or - warn SQL::Translator::Schema::View->error; - my $check_view = $schema->add_view( $view2 ); + my $view2 = SQL::Translator::Schema::View->new( name => 'view2' ) + or warn SQL::Translator::Schema::View->error; + my $check_view = $schema->add_view($view2); is( $check_view->name, 'view2', 'Add view "view2"' ); - my $redundant_view = $schema->add_view(name => 'view2'); + my $redundant_view = $schema->add_view( name => 'view2' ); is( $redundant_view, undef, qq[Didn't create another "view2" view...] ); like( $schema->error, qr/can't create view/i, '... because it exists' ); # # $schema-> drop_view # - my $dropped_view = $schema->drop_view($view->name); - isa_ok($dropped_view, 'SQL::Translator::Schema::View', 'Dropped view "view1"' ); + my $dropped_view = $schema->drop_view( $view->name ); + isa_ok( + $dropped_view, + 'SQL::Translator::Schema::View', + 'Dropped view "view1"' + ); $schema->add_view($view); my $dropped_view2 = $schema->drop_view($view); - isa_ok($dropped_view2, 'SQL::Translator::Schema::View', 'Dropped view "view1" by object' ); - is($dropped_view2->name, $view->name, 'Dropped correct view "view1"'); - my $dropped_view3 = $schema->drop_view($view->name); - like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant view "view1"] ); + isa_ok( + $dropped_view2, + 'SQL::Translator::Schema::View', + 'Dropped view "view1" by object' + ); + is( $dropped_view2->name, $view->name, 'Dropped correct view "view1"' ); + my $dropped_view3 = $schema->drop_view( $view->name ); + like( + $schema->error, + qr/doesn't exist/, + qq[Can't drop non-existant view "view1"] + ); $schema->add_view($view); @@ -428,15 +528,14 @@ require_ok( 'SQL::Translator::Schema' ); like( $schema->error, qr/no view/i, 'Error on no arg to get_view' ); $bad_view = $schema->get_view('bar'); - like( $schema->error, qr/does not exist/i, - 'Error on bad arg to get_view' ); + like( $schema->error, qr/does not exist/i, 'Error on bad arg to get_view' ); my $good_table = $schema->get_table('foo'); isa_ok( $good_table, 'SQL::Translator::Schema::Table', 'Table "foo"' ); my $good_view = $schema->get_view('view1'); isa_ok( $good_view, 'SQL::Translator::Schema::View', 'View "view1"' ); - is( $view->sql( $view_sql ), $view_sql, 'View SQL is good' ); + is( $view->sql($view_sql), $view_sql, 'View SQL is good' ); # # $schema->get_*s @@ -453,20 +552,20 @@ require_ok( 'SQL::Translator::Schema' ); # Test ability to introspect some values # { - my $s = SQL::Translator::Schema->new( + my $s = SQL::Translator::Schema->new( name => 'foo', database => 'PostgreSQL', ); - my $t = $s->add_table( name => 'person' ) or warn $s->error; + my $t = $s->add_table( name => 'person' ) or warn $s->error; my $f = $t->add_field( name => 'person_id' ) or warn $t->error; $f->data_type('serial'); - my $c = $t->add_constraint( - type => PRIMARY_KEY, - fields => 'person_id', + my $c = $t->add_constraint( + type => PRIMARY_KEY, + fields => 'person_id', ) or warn $t->error; - is( $f->is_primary_key, 1, 'Field is PK' ); + is( $f->is_primary_key, 1, 'Field is PK' ); is( $f->is_auto_increment, 1, 'Field is auto inc' ); } @@ -476,59 +575,74 @@ require_ok( 'SQL::Translator::Schema' ); { my $s = SQL::Translator::Schema->new; my $t = $s->add_table( name => 'person' ) or warn $s->error; - my $c = $t->add_constraint or warn $t->error; + my $c = $t->add_constraint or warn $t->error; - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); like( $c->error, qr/no type/i, '...because it has no type' ); - is( $c->type( FOREIGN_KEY ), FOREIGN_KEY, 'Constraint type now a FK' ); + is( $c->type(FOREIGN_KEY), FOREIGN_KEY, 'Constraint type now a FK' ); - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); like( $c->error, qr/no fields/i, '...because it has no fields' ); - is( join('', $c->fields('foo')), 'foo', 'Fields now = "foo"' ); + is( join( '', $c->fields('foo') ), 'foo', 'Fields now = "foo"' ); - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); - like( $c->error, qr/non-existent field/i, - q[...because field "foo" doesn't exist] ); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); + like( + $c->error, + qr/non-existent field/i, + q[...because field "foo" doesn't exist] + ); my $fk = $t->add_field( name => 'pet_id' ); - is( $fk->name, 'pet_id', 'Added field "pet_id"' ); - is( join('', $c->fields('pet_id')), 'pet_id', 'Fields now = "pet_id"' ); + is( $fk->name, 'pet_id', 'Added field "pet_id"' ); + is( join( '', $c->fields('pet_id') ), 'pet_id', 'Fields now = "pet_id"' ); $t->add_field( name => 'f1' ); $t->add_field( name => 'f2' ); - is( join(',', $c->fields('f1,f2')), 'f1,f2', 'Fields now = "f1,f2"' ); - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); + is( join( ',', $c->fields('f1,f2') ), 'f1,f2', 'Fields now = "f1,f2"' ); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); like( $c->error, qr/only one field/i, q[...because too many fields for FK] ); $c->fields('f1'); - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); - like( $c->error, qr/no reference table/i, - q[...because there's no reference table] ); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); + like( + $c->error, + qr/no reference table/i, + q[...because there's no reference table] + ); is( $c->reference_table('foo'), 'foo', 'Reference table now = "foo"' ); - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); - like( $c->error, qr/no table named/i, - q[...because reference table "foo" doesn't exist] ); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); + like( + $c->error, + qr/no table named/i, + q[...because reference table "foo" doesn't exist] + ); my $t2 = $s->add_table( name => 'pet' ); is( $t2->name, 'pet', 'Added "pet" table' ); is( $c->reference_table('pet'), 'pet', 'Reference table now = "pet"' ); - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); - like( $c->error, qr/no reference fields/i, - q[...because there're no reference fields]); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); + like( + $c->error, + qr/no reference fields/i, + q[...because there're no reference fields] + ); - is( join('', $c->reference_fields('pet_id')), 'pet_id', - 'Reference fields = "pet_id"' ); + is( join( '', $c->reference_fields('pet_id') ), + 'pet_id', 'Reference fields = "pet_id"' ); - is( $c->is_valid, undef, 'Constraint on "person" not valid...'); - like( $c->error, qr/non-existent field/i, - q[...because there's no "pet_id" field in "pet"]); + is( $c->is_valid, undef, 'Constraint on "person" not valid...' ); + like( + $c->error, + qr/non-existent field/i, + q[...because there's no "pet_id" field in "pet"] + ); my $pet_id = $t2->add_field( name => 'pet_id' ); is( $pet_id->name, 'pet_id', 'Added field "pet_id"' ); @@ -545,8 +659,8 @@ require_ok( 'SQL::Translator::Schema' ); is( $t->primary_key, undef, 'No primary key' ); - is( $t->primary_key('person_id'), undef, - q[Can't make PK on "person_id"...] ); + is( $t->primary_key('person_id'), + undef, q[Can't make PK on "person_id"...] ); like( $t->error, qr/invalid field/i, "...because it doesn't exist" ); $t->add_field( name => 'person_id' ); @@ -554,12 +668,12 @@ require_ok( 'SQL::Translator::Schema' ); isa_ok( $c, 'SQL::Translator::Schema::Constraint', 'Constraint' ); - is( join('', $c->fields), 'person_id', 'Constraint now on "person_id"' ); + is( join( '', $c->fields ), 'person_id', 'Constraint now on "person_id"' ); $t->add_field( name => 'name' ); $c = $t->primary_key('name'); - is( join(',', $c->fields), 'person_id,name', - 'Constraint now on "person_id" and "name"' ); + is( join( ',', $c->fields ), + 'person_id,name', 'Constraint now on "person_id" and "name"' ); is( scalar @{ $t->get_constraints }, 1, 'Found 1 constraint' ); } @@ -572,7 +686,7 @@ require_ok( 'SQL::Translator::Schema' ); my $t1 = $s->add_table( name => 'person' ); my $t2 = $s->add_table( name => 'pet' ); $t1->add_field( name => 'id' ); - my $c1 = $t1->primary_key( 'id' ) or warn $t1->error; + my $c1 = $t1->primary_key('id') or warn $t1->error; is( $c1->type, PRIMARY_KEY, 'Made "person_id" PK on "person"' ); $t2->add_field( name => 'person_id' ); @@ -582,7 +696,7 @@ require_ok( 'SQL::Translator::Schema' ); reference_table => 'person', ); - is( join('', $c2->reference_fields), 'id', 'FK found PK "person.id"' ); + is( join( '', $c2->reference_fields ), 'id', 'FK found PK "person.id"' ); } # @@ -600,17 +714,17 @@ require_ok( 'SQL::Translator::Schema' ); schema => $s, ); - isa_ok( $v, 'SQL::Translator::Schema::View', 'View' ); - isa_ok( $v->schema, 'SQL::Translator::Schema', 'Schema' ); - is( $v->schema->name, 'ViewTest', qq[Schema name is "'ViewTest'"] ); - is( $v->name, $name, qq[Name is "$name"] ); - is( $v->sql, $sql, qq[Name is "$sql"] ); - is( join(':', $v->fields), 'name:age', qq[Fields are "$fields"] ); + isa_ok( $v, 'SQL::Translator::Schema::View', 'View' ); + isa_ok( $v->schema, 'SQL::Translator::Schema', 'Schema' ); + is( $v->schema->name, 'ViewTest', qq[Schema name is "'ViewTest'"] ); + is( $v->name, $name, qq[Name is "$name"] ); + is( $v->sql, $sql, qq[Name is "$sql"] ); + is( join( ':', $v->fields ), 'name:age', qq[Fields are "$fields"] ); my @views = $s->get_views; is( scalar @views, 1, 'Number of views is 1' ); - my $v1 = $s->get_view( $name ); + my $v1 = $s->get_view($name); isa_ok( $v1, 'SQL::Translator::Schema::View', 'View' ); is( $v1->name, $name, qq[Name is "$name"] ); } @@ -619,8 +733,8 @@ require_ok( 'SQL::Translator::Schema' ); # Trigger # { - my $s = SQL::Translator::Schema->new(name => 'TrigTest'); - $s->add_table(name=>'foo') or die "Couldn't create table: ", $s->error; + my $s = SQL::Translator::Schema->new( name => 'TrigTest' ); + $s->add_table( name => 'foo' ) or die "Couldn't create table: ", $s->error; my $name = 'foo_trigger'; my $perform_action_when = 'after'; my $database_events = 'insert'; @@ -634,75 +748,82 @@ require_ok( 'SQL::Translator::Schema' ); action => $action, ) or die $s->error; - isa_ok( $t, 'SQL::Translator::Schema::Trigger', 'Trigger' ); - isa_ok( $t->schema, 'SQL::Translator::Schema', 'Schema' ); + isa_ok( $t, 'SQL::Translator::Schema::Trigger', 'Trigger' ); + isa_ok( $t->schema, 'SQL::Translator::Schema', 'Schema' ); is( $t->schema->name, 'TrigTest', qq[Schema name is "'TrigTest'"] ); - is( $t->name, $name, qq[Name is "$name"] ); + is( $t->name, $name, qq[Name is "$name"] ); is( $t->perform_action_when, $perform_action_when, qq[Perform action when is "$perform_action_when"] ); - is( join(',', $t->database_events), $database_events, - qq[Database event is "$database_events"] ); - isa_ok( $t->table, 'SQL::Translator::Schema::Table', qq[table is a Table"] ); + is( join( ',', $t->database_events ), + $database_events, qq[Database event is "$database_events"] ); + isa_ok( $t->table, 'SQL::Translator::Schema::Table', + qq[table is a Table"] ); is( $t->action, $action, qq[Action is "$action"] ); my @triggs = $s->get_triggers; is( scalar @triggs, 1, 'Number of triggers is 1' ); - my $t1 = $s->get_trigger( $name ); + my $t1 = $s->get_trigger($name); isa_ok( $t1, 'SQL::Translator::Schema::Trigger', 'Trigger' ); is( $t1->name, $name, qq[Name is "$name"] ); - - - my $s2 = SQL::Translator::Schema->new(name => 'TrigTest2'); - $s2->add_table(name=>'foo') or die "Couldn't create table: ", $s2->error; - my $t2 = $s2->add_trigger( + my $s2 = SQL::Translator::Schema->new( name => 'TrigTest2' ); + $s2->add_table( name => 'foo' ) + or die "Couldn't create table: ", $s2->error; + my $t2 = $s2->add_trigger( name => 'foo_trigger', perform_action_when => 'after', database_events => [qw/insert update/], on_table => 'foo', action => 'update modified=timestamp();', ) or die $s2->error; - isa_ok( $t2, 'SQL::Translator::Schema::Trigger', 'Trigger' ); - isa_ok( $t2->schema, 'SQL::Translator::Schema', 'Schema' ); - is( $t2->schema->name, 'TrigTest2', qq[Schema name is "'TrigTest2'"] ); - is( $t2->name, 'foo_trigger', qq[Name is "foo_trigger"] ); - is_deeply( - [$t2->database_events], - [qw/insert update/], - "Database events are [qw/insert update/] " - ); - isa_ok($t2->database_events,'ARRAY','Database events'); + isa_ok( $t2, 'SQL::Translator::Schema::Trigger', 'Trigger' ); + isa_ok( $t2->schema, 'SQL::Translator::Schema', 'Schema' ); + is( $t2->schema->name, 'TrigTest2', qq[Schema name is "'TrigTest2'"] ); + is( $t2->name, 'foo_trigger', qq[Name is "foo_trigger"] ); + is_deeply( [ $t2->database_events ], + [qw/insert update/], "Database events are [qw/insert update/] " ); + isa_ok( $t2->database_events, 'ARRAY', 'Database events' ); # # Trigger equal tests # - isnt( - $t1->equals($t2), - 1, - 'Compare two Triggers with database_event and database_events' - ); + isnt( $t1->equals($t2), 1, + 'Compare two Triggers with database_event and database_events' ); $t1->database_events($database_events); $t2->database_events($database_events); - is($t1->equals($t2),1,'Compare two Triggers with database_event'); + is( $t1->equals($t2), 1, 'Compare two Triggers with database_event' ); $t2->database_events(''); - $t1->database_events([qw/update insert/]); - $t2->database_events([qw/insert update/]); - is($t1->equals($t2),1,'Compare two Triggers with database_events'); + $t1->database_events( [qw/update insert/] ); + $t2->database_events( [qw/insert update/] ); + is( $t1->equals($t2), 1, 'Compare two Triggers with database_events' ); # # $schema-> drop_trigger # - my $dropped_trig = $s->drop_trigger($t->name); - isa_ok($dropped_trig, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger"' ); + my $dropped_trig = $s->drop_trigger( $t->name ); + isa_ok( + $dropped_trig, + 'SQL::Translator::Schema::Trigger', + 'Dropped trigger "foo_trigger"' + ); $s->add_trigger($t); my $dropped_trig2 = $s->drop_trigger($t); - isa_ok($dropped_trig2, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger" by object' ); - is($dropped_trig2->name, $t->name, 'Dropped correct trigger "foo_trigger"'); - my $dropped_trig3 = $s->drop_trigger($t->name); - like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant trigger "foo_trigger"] ); + isa_ok( + $dropped_trig2, + 'SQL::Translator::Schema::Trigger', + 'Dropped trigger "foo_trigger" by object' + ); + is( $dropped_trig2->name, $t->name, + 'Dropped correct trigger "foo_trigger"' ); + my $dropped_trig3 = $s->drop_trigger( $t->name ); + like( + $s->error, + qr/doesn't exist/, + qq[Can't drop non-existant trigger "foo_trigger"] + ); $s->add_trigger($t); } @@ -725,32 +846,45 @@ require_ok( 'SQL::Translator::Schema' ); comments => $comments, ) or die $s->error; - isa_ok( $p, 'SQL::Translator::Schema::Procedure', 'Procedure' ); - isa_ok( $p->schema, 'SQL::Translator::Schema', 'Schema' ); + isa_ok( $p, 'SQL::Translator::Schema::Procedure', 'Procedure' ); + isa_ok( $p->schema, 'SQL::Translator::Schema', 'Schema' ); is( $p->schema->name, 'ProcTest', qq[Schema name is "'ProcTest'"] ); - is( $p->name, $name, qq[Name is "$name"] ); - is( $p->sql, $sql, qq[SQL is "$sql"] ); - is( join(',', $p->parameters), 'foo,bar', qq[Params = 'foo,bar'] ); - is( $p->comments, $comments, qq[Comments = "$comments"] ); + is( $p->name, $name, qq[Name is "$name"] ); + is( $p->sql, $sql, qq[SQL is "$sql"] ); + is( join( ',', $p->parameters ), 'foo,bar', qq[Params = 'foo,bar'] ); + is( $p->comments, $comments, qq[Comments = "$comments"] ); my @procs = $s->get_procedures; is( scalar @procs, 1, 'Number of procedures is 1' ); - my $p1 = $s->get_procedure( $name ); + my $p1 = $s->get_procedure($name); isa_ok( $p1, 'SQL::Translator::Schema::Procedure', 'Procedure' ); is( $p1->name, $name, qq[Name is "$name"] ); # # $schema-> drop_procedure # - my $dropped_proc = $s->drop_procedure($p->name); - isa_ok($dropped_proc, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc"' ); + my $dropped_proc = $s->drop_procedure( $p->name ); + isa_ok( + $dropped_proc, + 'SQL::Translator::Schema::Procedure', + 'Dropped procedure "foo_proc"' + ); $s->add_procedure($p); my $dropped_proc2 = $s->drop_procedure($p); - isa_ok($dropped_proc2, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc" by object' ); - is($dropped_proc2->name, $p->name, 'Dropped correct procedure "foo_proc"'); - my $dropped_proc3 = $s->drop_procedure($p->name); - like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant procedure "foo_proc"] ); + isa_ok( + $dropped_proc2, + 'SQL::Translator::Schema::Procedure', + 'Dropped procedure "foo_proc" by object' + ); + is( $dropped_proc2->name, $p->name, + 'Dropped correct procedure "foo_proc"' ); + my $dropped_proc3 = $s->drop_procedure( $p->name ); + like( + $s->error, + qr/doesn't exist/, + qq[Can't drop non-existant procedure "foo_proc"] + ); $s->add_procedure($p); } @@ -760,10 +894,10 @@ require_ok( 'SQL::Translator::Schema' ); # { my $s = SQL::Translator::Schema->new; - my $t = $s->add_table( name => 'person' ); - my $f3 = $t->add_field( name => 'age', order => 3 ); + my $t = $s->add_table( name => 'person' ); + my $f3 = $t->add_field( name => 'age', order => 3 ); my $f1 = $t->add_field( name => 'person_id', order => 1 ); - my $f2 = $t->add_field( name => 'name', order => 2 ); + my $f2 = $t->add_field( name => 'name', order => 2 ); my $f4 = $t->add_field( name => 'gender' ); my $f5 = $t->add_field( name => 'alias' ); @@ -773,14 +907,14 @@ require_ok( 'SQL::Translator::Schema' ); is( $f4->order, 4, 'Field order is not passed, order is 4' ); is( $f5->order, 5, 'Field order is not passed, order is 5' ); - my $t2 = $s->add_table( name => 'place' ); + my $t2 = $s->add_table( name => 'place' ); $f2 = $t2->add_field( name => 'name', order => 2 ); throws_ok { my $f22 = $t2->add_field( name => 'name2', order => 2 ) } - qr/\QRequested order '2' for column 'name2' conflicts with already existing column 'name'/; +qr/\QRequested order '2' for column 'name2' conflicts with already existing column 'name'/; throws_ok { $f1 = $t2->add_field( name => 'location' ) } - qr/field order incomplete/; + qr/field order incomplete/; } # @@ -788,47 +922,47 @@ require_ok( 'SQL::Translator::Schema' ); # { - my $s = SQL::Translator::Schema->new; + my $s = SQL::Translator::Schema->new; my $t1 = $s->add_table( name => 'person' ); $t1->add_field( name => 'id' ); - $t1->primary_key( 'id' ); + $t1->primary_key('id'); $t1->add_field( name => 'name' ); - ok( $t1->is_data, 'Person table has data' ); + 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->primary_key('id'); $t2->add_field( name => 'name' ); - ok( $t2->is_data, 'Pet table has data' ); + 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->primary_key('id'); $t3->add_constraint( - type => FOREIGN_KEY, - fields => 'person_id', + type => FOREIGN_KEY, + fields => 'person_id', reference_table => $t1, ); $t3->add_constraint( - type => FOREIGN_KEY, - fields => 'pet_id', + 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_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' ); + 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' ); @@ -836,26 +970,27 @@ require_ok( 'SQL::Translator::Schema' ); $t4->primary_key( 'fan_id', 'idol_id' ); $t4->add_constraint( - type => FOREIGN_KEY, - name => 'fan_fan_fk', - fields => 'fan_id', + 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', + 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_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' ); + 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;