X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F25backcompat.t;h=57a9c04ebb2a6a3b74923f33fa1ca723dc8abd27;hb=1de9c8e18dde9ef2accda369fe8616c230583eb2;hp=dfb4f4e4b5b04947ecd21849d13b5b43d9e51d0c;hpb=ecf930e6ea3321d8ae6e042b282c824897684c18;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/25backcompat.t b/t/25backcompat.t index dfb4f4e..57a9c04 100644 --- a/t/25backcompat.t +++ b/t/25backcompat.t @@ -6,16 +6,19 @@ use File::Path qw/rmtree make_path/; use Class::Unload; use File::Temp qw/tempfile tempdir/; use IO::File; -use File::Slurp 'slurp'; use DBIx::Class::Schema::Loader (); +use DBIx::Class::Schema::Loader::Utils 'slurp_file'; use Lingua::EN::Inflect::Number (); use lib qw(t/lib); use make_dbictest_db_with_unique; +use dbixcsl_test_dir qw/$tdir/; -my $DUMP_DIR = './t/_common_dump'; +my $DUMP_DIR = "$tdir/common_dump"; rmtree $DUMP_DIR; my $SCHEMA_CLASS = 'DBIXCSL_Test::Schema'; +my $RESULT_COUNT = 7; + sub class_content_like; # test dynamic schema in 0.04006 mode @@ -45,7 +48,7 @@ sub class_content_like; { my $res = run_loader(naming => 'current'); is_deeply $res->{warnings}, [], 'no warnings with naming attribute set'; - run_v6_tests($res); + run_v7_tests($res); } # test upgraded dynamic schema with external content loaded @@ -55,7 +58,7 @@ sub class_content_like; Bar => 'Foos', }); - my $res = run_loader(naming => 'current'); + my $res = run_loader(naming => 'current', use_namespaces => 0); my $schema = $res->{schema}; is scalar @{ $res->{warnings} }, 1, @@ -82,7 +85,7 @@ sub class_content_like; 'unsingularized class names in external content from unchanged Result class ' . 'names are translated'; - run_v6_tests($res); + run_v7_tests($res); } # test upgraded dynamic schema with use_namespaces with external content loaded @@ -116,7 +119,7 @@ sub class_content_like; 'unsingularized class names in external content from unchanged Result class ' . 'names are translated'; - run_v6_tests($res); + run_v7_tests($res); } # test upgraded static schema with external content loaded @@ -133,7 +136,7 @@ sub class_content_like; my $res = run_loader(static => 1, naming => 'current'); my $schema = $res->{schema}; - run_v6_tests($res); + run_v7_tests($res); lives_and { is $schema->resultset('Quux')->find(1)->a_method, 'hlagh' } 'external custom content for unsingularized Result was loaded by upgraded ' . @@ -155,29 +158,6 @@ sub class_content_like; 'external custom content loaded into static dump correctly'; } -# test creating static schema in v5 mode then upgrade to current with external -# content loaded -# XXX needs real load_external tests -{ - clean_dumpdir(); - - my $temp_dir = setup_load_external({ - Quux => 'Baz', - Bar => 'Foo', - }, { result_namespace => 'Result' }); - - write_v5_schema_pm(); - - my $res = run_loader(static => 1); - - run_v5_tests($res); - - $res = run_loader(static => 1, naming => 'current'); - my $schema = $res->{schema}; - - run_v6_tests($res); -} - # test running against v4 schema without upgrade, twice, then upgrade { clean_dumpdir(); @@ -224,9 +204,9 @@ sub class_content_like; 'correct number of warnings on upgrading static schema (with "naming" set)' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); - is result_count('Result'), 6, + is result_count('Result'), $RESULT_COUNT, 'un-singularized results were replaced during upgrade'; # check that custom content was preserved @@ -288,9 +268,9 @@ sub class_content_like; 'correct number of warnings on upgrading static schema (with "naming" set)' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); - is result_count(), 6, + is result_count(), $RESULT_COUNT, 'un-singularized results were replaced during upgrade'; # check that custom content was preserved @@ -362,9 +342,9 @@ sub class_content_like; 'correct number of warnings on upgrading static schema (with "naming" set)' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); - is result_count(), 6, + is result_count(), $RESULT_COUNT, 'un-singularized results were replaced during upgrade and Result dir removed'; ok ((not -d result_dir('Result')), @@ -407,6 +387,7 @@ sub class_content_like; clean_dumpdir => 1, static => 1, use_namespaces => 0, + naming => 'current', ); like $res->{warnings}[0], qr/Dumping manual schema/i, @@ -419,7 +400,7 @@ sub class_content_like; 'correct number of warnings on dumping static schema with use_namespaces => 0' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); my $schema = $res->{schema}; add_custom_content($res->{schema}, { @@ -428,7 +409,7 @@ sub class_content_like; # test that with no use_namespaces option, there is a warning and # load_classes is preserved - $res = run_loader(static => 1); + $res = run_loader(static => 1, naming => 'current'); like $res->{warnings}[0], qr/load_classes/i, 'correct warnings on re-dumping static schema with load_classes'; @@ -446,12 +427,13 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', 'load_classes preserved on re-dump'; - run_v6_tests($res); + run_v7_tests($res); # now upgrade the schema to use_namespaces $res = run_loader( static => 1, use_namespaces => 1, + naming => 'current', ); $schema = $res->{schema}; @@ -465,7 +447,7 @@ sub class_content_like; 'correct number of warnings on upgrading to use_namespaces' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); my @schema_files = schema_files(); @@ -490,7 +472,7 @@ sub class_content_like; # test a regular schema with default use_namespaces => 1, redump, and downgrade # to load_classes { - my $res = run_loader(clean_dumpdir => 1, static => 1); + my $res = run_loader(clean_dumpdir => 1, static => 1, naming => 'current'); like $res->{warnings}[0], qr/Dumping manual schema/i, 'correct warnings on dumping static schema'; @@ -502,7 +484,7 @@ sub class_content_like; 'correct number of warnings on dumping static schema' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', 'defaults to use_namespaces on regular dump'; @@ -510,7 +492,7 @@ sub class_content_like; add_custom_content($res->{schema}, { Quux => 'Baz' }, { result_namespace => 'Result' }); # test that with no use_namespaces option, use_namespaces is preserved - $res = run_loader(static => 1); + $res = run_loader(static => 1, naming => 'current'); like $res->{warnings}[0], qr/Dumping manual schema/i, 'correct warnings on re-dumping static schema'; @@ -525,12 +507,13 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Result::Quux', 'use_namespaces preserved on re-dump'; - run_v6_tests($res); + run_v7_tests($res); # now downgrade the schema to load_classes $res = run_loader( static => 1, use_namespaces => 0, + naming => 'current', ); my $schema = $res->{schema}; @@ -544,12 +527,12 @@ sub class_content_like; 'correct number of warnings on downgrading to load_classes' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', 'load_classes downgrade correct'; - is result_count(), 6, + is result_count(), $RESULT_COUNT, 'correct number of Results after upgrade and Result dir removed'; ok ((not -d result_dir('Result')), @@ -576,6 +559,7 @@ sub class_content_like; clean_dumpdir => 1, static => 1, result_namespace => 'MyResult', + naming => 'current', ); like $res->{warnings}[0], qr/Dumping manual schema/i, @@ -588,7 +572,7 @@ sub class_content_like; 'correct number of warnings on dumping static schema' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', 'defaults to use_namespaces and uses custom result_namespace'; @@ -597,7 +581,7 @@ sub class_content_like; # test that with no use_namespaces option, use_namespaces is preserved, and # the custom result_namespace is preserved - $res = run_loader(static => 1); + $res = run_loader(static => 1, naming => 'current'); like $res->{warnings}[0], qr/Dumping manual schema/i, 'correct warnings on re-dumping static schema'; @@ -612,12 +596,13 @@ sub class_content_like; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', 'use_namespaces and custom result_namespace preserved on re-dump'; - run_v6_tests($res); + run_v7_tests($res); # now downgrade the schema to load_classes $res = run_loader( static => 1, use_namespaces => 0, + naming => 'current', ); my $schema = $res->{schema}; @@ -631,12 +616,12 @@ sub class_content_like; 'correct number of warnings on downgrading to load_classes' or diag @{ $res->{warnings} }; - run_v6_tests($res); + run_v7_tests($res); is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Quux', 'load_classes downgrade correct'; - is result_count(), 6, + is result_count(), $RESULT_COUNT, 'correct number of Results after upgrade and Result dir removed'; ok ((not -d result_dir('MyResult')), @@ -661,7 +646,7 @@ sub class_content_like; clean_dumpdir(); my $temp_dir = setup_load_external({ Quux => 'Baz', Bar => 'Foo' }, { result_namespace => 'Result' }); - my $res = run_loader(static => 1); + my $res = run_loader(static => 1, naming => 'current'); # add some custom content to a Result that will be replaced add_custom_content($res->{schema}, { Quux => 'Baz' }, { result_namespace => 'Result', rel_name_map => { QuuxBaz => 'bazrel2' } }); @@ -670,13 +655,14 @@ sub class_content_like; $res = run_loader( static => 1, result_namespace => 'MyResult', + naming => 'current', ); my $schema = $res->{schema}; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::MyResult::Quux', 'using new result_namespace'; - is result_count('MyResult'), 6, + is result_count('MyResult'), $RESULT_COUNT, 'correct number of Results after rewritten result_namespace'; ok ((not -d schema_dir('Result')), @@ -698,13 +684,14 @@ sub class_content_like; $res = run_loader( static => 1, result_namespace => 'Mtfnpy', + naming => 'current', ); $schema = $res->{schema}; is $res->{classes}{quuxs}, 'DBIXCSL_Test::Schema::Mtfnpy::Quux', 'using new result_namespace'; - is result_count('Mtfnpy'), 6, + is result_count('Mtfnpy'), $RESULT_COUNT, 'correct number of Results after rewritten result_namespace'; ok ((not -d result_dir('MyResult')), @@ -747,8 +734,8 @@ sub class_content_like; my $res = run_loader(static => 1, naming => 'current'); my $schema = $res->{schema}; - my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS); - my $code = slurp $file; + my $file = $schema->loader->get_dump_filename($SCHEMA_CLASS); + my $code = slurp_file $file; my ($dumped_ver) = $code =~ /^# Created by DBIx::Class::Schema::Loader v(\S+)/m; @@ -772,7 +759,7 @@ sub class_content_like; # now upgrade the schema $res = run_loader(static => 1, naming => 'current'); $schema = $res->{schema}; - run_v6_tests($res); + run_v7_tests($res); # check that custom content was preserved lives_and { is $schema->resultset('Bar')->find(1)->b_method, 'dongs' } @@ -788,6 +775,93 @@ sub class_content_like; 'correctly'; } +# test creating static schema in v5 mode then upgrade to current with external +# content loaded +{ + clean_dumpdir(); + + write_v5_schema_pm(); + + my $res = run_loader(static => 1); + + like $res->{warnings}[0], qr/0.05003 static schema/, 'backcompat warning'; + + run_v5_tests($res); + + my $temp_dir = setup_load_external({ + Baz => 'StationsVisited', + StationsVisited => 'Quux', + }, { result_namespace => 'Result' }); + + add_custom_content($res->{schema}, { + Baz => 'StationsVisited', + }, { + result_namespace => 'Result', + rel_name_map => { BazStationsvisited => 'custom_content_rel' }, + }); + + $res = run_loader(static => 1, naming => 'current'); + my $schema = $res->{schema}; + + run_v7_tests($res); + + lives_and { is $schema->resultset('Baz')->find(1)->a_method, 'hlagh' } + 'external custom content loaded for v5 -> v6'; + + lives_and { isa_ok $schema->resultset('Baz')->find(1)->stationsvisitedrel, + $res->{classes}{stations_visited} } + 'external content rewritten for v5 -> v6'; + + lives_and { isa_ok $schema->resultset('Baz')->find(1)->custom_content_rel, + $res->{classes}{stations_visited} } + 'custom content rewritten for v5 -> v6'; + + lives_and { isa_ok $schema->resultset('StationVisited')->find(1)->quuxrel, + $res->{classes}{quuxs} } + 'external content rewritten for v5 -> v6 for upgraded Result class names'; +} + +# test creating static schema in v6 mode then upgrade to current with external +# content loaded +{ + clean_dumpdir(); + + write_v6_schema_pm(); + + my $res = run_loader(static => 1); + + like $res->{warnings}[0], qr/0.06001 static schema/, 'backcompat warning'; + + run_v6_tests($res); + + my $temp_dir = setup_load_external({ + Routechange => 'Quux', + }, { result_namespace => 'Result' }); + + add_custom_content($res->{schema}, { + Routechange => 'Quux', + }, { + result_namespace => 'Result', + rel_name_map => { RoutechangeQuux => 'custom_content_rel' }, + }); + + $res = run_loader(static => 1, naming => 'current'); + my $schema = $res->{schema}; + + run_v7_tests($res); + + lives_and { is $schema->resultset('RouteChange')->find(1)->a_method, 'hlagh' } + 'external custom content loaded for v6 -> v7'; + + lives_and { isa_ok $schema->resultset('RouteChange')->find(1)->quuxrel, + $res->{classes}{quuxs} } + 'external content rewritten for v6 -> v7'; + + lives_and { isa_ok $schema->resultset('RouteChange')->find(1)->custom_content_rel, + $res->{classes}{quuxs} } + 'custom content rewritten for v6 -> v7'; +} + done_testing; END { @@ -803,6 +877,7 @@ sub run_loader { my %loader_opts = @_; $loader_opts{dump_directory} = $DUMP_DIR if delete $loader_opts{static}; + $loader_opts{preserve_case} = 1 if $loader_opts{naming} && $loader_opts{naming} eq 'current'; clean_dumpdir() if delete $loader_opts{clean_dumpdir}; @@ -817,7 +892,7 @@ sub run_loader { my @connect_info = $make_dbictest_db_with_unique::dsn; my @loader_warnings; - local $SIG{__WARN__} = sub { push(@loader_warnings, $_[0]); }; + local $SIG{__WARN__} = sub { push(@loader_warnings, @_); }; eval qq{ package $SCHEMA_CLASS; use base qw/DBIx::Class::Schema::Loader/; @@ -938,11 +1013,67 @@ use warnings; use base 'DBIx::Class::Schema'; +__PACKAGE__->load_namespaces; + + +# Created by DBIx::Class::Schema::Loader v0.05003 @ 2010-03-29 19:44:52 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:D+MYxtGxz97Ghvido5DTEg + + +# You can replace this text with custom content, and it will be preserved on regeneration +1; +EOF + } +} + +sub write_v6_schema_pm { + my %opts = @_; + + (my $schema_dir = "$DUMP_DIR/$SCHEMA_CLASS") =~ s/::[^:]+\z//; + rmtree $schema_dir; + make_path $schema_dir; + my $schema_pm = "$schema_dir/Schema.pm"; + open my $fh, '>', $schema_pm or die $!; + if (exists $opts{use_namespaces} && $opts{use_namespaces} == 0) { + print $fh <<'EOF'; +package DBIXCSL_Test::Schema; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +use strict; +use warnings; + +use base 'DBIx::Class::Schema'; + __PACKAGE__->load_classes; -# Created by DBIx::Class::Schema::Loader v0.05003 @ 2010-03-27 17:07:37 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:LIzC/LT5IYvWpgusfbqMrg +# Created by DBIx::Class::Schema::Loader v0.06001 @ 2010-04-21 19:56:03 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:/fqZCb95hsGIe1g5qyQQZg + + +# You can replace this text with custom content, and it will be preserved on regeneration +1; +EOF + } + else { + print $fh <<'EOF'; +package DBIXCSL_Test::Schema; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +use strict; +use warnings; + +use base 'DBIx::Class::Schema'; + +__PACKAGE__->load_namespaces; + + +# Created by DBIx::Class::Schema::Loader v0.06001 @ 2010-04-21 19:54:31 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:nwO5Vi47kl0X9SpEoiVO5w # You can replace this text with custom content, and it will be preserved on regeneration @@ -955,8 +1086,8 @@ sub run_v4_tests { my $res = shift; my $schema = $res->{schema}; - is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited email/} ], - [qw/Foos Bar Bazs Quuxs StationsVisited Email/], + is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], + [qw/Foos Bar Bazs Quuxs StationsVisited Routechange Email/], 'correct monikers in 0.04006 mode'; isa_ok ((my $bar = eval { $schema->resultset('Bar')->find(1) }), @@ -975,15 +1106,21 @@ sub run_v4_tests { isa_ok eval { $foo->email_to_ids }, 'DBIx::Class::ResultSet', 'correct rel name inflection in 0.04006 mode'; + + ok (($schema->resultset('Routechange')->find(1)->can('quuxsid')), + 'correct column accessor in 0.04006 mode'); + + is $schema->resultset('Routechange')->find(1)->foo2bar, 3, + 'correct column accessor for column with word ending with digit in v4 mode'; } sub run_v5_tests { my $res = shift; my $schema = $res->{schema}; - is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited email/} ], - [qw/Foo Bar Baz Quux StationsVisited Email/], - 'correct monikers in current mode'; + is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], + [qw/Foo Bar Baz Quux StationsVisited Routechange Email/], + 'correct monikers in v5 mode'; ok my $bar = eval { $schema->resultset('Bar')->find(1) }; @@ -999,14 +1136,55 @@ sub run_v5_tests { isa_ok eval { $foo->email_to_ids }, 'DBIx::Class::ResultSet', 'correct rel name inflection in v5 mode'; + + ok (($schema->resultset('Routechange')->find(1)->can('quuxsid')), + 'correct column accessor in v5 mode'); + + is $schema->resultset('Routechange')->find(1)->foo2bar, 3, + 'correct column accessor for column with word ending with digit in v5 mode'; } sub run_v6_tests { my $res = shift; my $schema = $res->{schema}; - is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited email/} ], - [qw/Foo Bar Baz Quux StationVisited Email/], + is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], + [qw/Foo Bar Baz Quux StationVisited Routechange Email/], + 'correct monikers in v6 mode'; + + ok my $bar = eval { $schema->resultset('Bar')->find(1) }; + + isa_ok eval { $bar->foo }, $res->{classes}{foos}, + 'correct rel name in v6 mode'; + + ok my $baz = eval { $schema->resultset('Baz')->find(1) }; + + isa_ok eval { $baz->quux }, $res->{classes}{quuxs}, + 'correct rel type and name for UNIQUE FK in v6 mode'; + + ok my $foo = eval { $schema->resultset('Foo')->find(1) }; + + isa_ok eval { $foo->emails_to }, 'DBIx::Class::ResultSet', + 'correct rel name inflection in v6 mode'; + + ok my $route_change = eval { $schema->resultset('Routechange')->find(1) }; + + isa_ok eval { $route_change->quuxsid }, $res->{classes}{quuxs}, + 'correct rel name in v6 mode'; + + ok (($schema->resultset('Routechange')->find(1)->can('quuxsid')), + 'correct column accessor in v6 mode'); + + is $schema->resultset('Routechange')->find(1)->foo2bar, 3, + 'correct column accessor for column with word ending with digit in v6 mode'; +} + +sub run_v7_tests { + my $res = shift; + my $schema = $res->{schema}; + + is_deeply [ @{ $res->{monikers} }{qw/foos bar bazs quuxs stations_visited RouteChange email/} ], + [qw/Foo Bar Baz Quux StationVisited RouteChange Email/], 'correct monikers in current mode'; ok my $bar = eval { $schema->resultset('Bar')->find(1) }; @@ -1023,6 +1201,17 @@ sub run_v6_tests { isa_ok eval { $foo->emails_to }, 'DBIx::Class::ResultSet', 'correct rel name inflection in current mode'; + + ok my $route_change = eval { $schema->resultset('RouteChange')->find(1) }; + + isa_ok eval { $route_change->quux }, $res->{classes}{quuxs}, + 'correct rel name based on mixed-case column name in current mode'; + + ok (($schema->resultset('RouteChange')->find(1)->can('quuxs_id')), + 'correct column accessor in current mode'); + + is $schema->resultset('RouteChange')->find(1)->foo2_bar, 3, + 'correct column accessor for column with word ending with digit in current mode'; } { @@ -1103,14 +1292,17 @@ sub _rel_condition { return +{ QuuxBaz => q{'foreign.baz_num' => 'self.baz_id'}, BarFoo => q{'foreign.fooid' => 'self.foo_id'}, + BazStationsvisited => q{'foreign.id' => 'self.stations_visited_id'}, + StationsvisitedQuux => q{'foreign.quuxid' => 'self.quuxs_id'}, + RoutechangeQuux => q{'foreign.quuxid' => 'self.QuuxsId'}, }->{_rel_key($from, $to)}; } sub class_content_like { my ($schema, $class, $re, $test_name) = @_; - my $file = $schema->_loader->_get_dump_filename($class); - my $code = slurp $file; + my $file = $schema->loader->get_dump_filename($class); + my $code = slurp_file $file; like $code, $re, $test_name; } @@ -1141,7 +1333,7 @@ EOF sub _write_custom_content { my ($schema, $class, $content) = @_; - my $pm = $schema->_loader->_get_dump_filename($class); + my $pm = $schema->loader->get_dump_filename($class); { local ($^I, @ARGV) = ('.bak', $pm); while (<>) {