X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F23dumpmore.t;h=a6f5445c4464ef20209b037cd0b2cbe3c423a1af;hb=61c8fd6d54d46095150040bd468e596572fcc378;hp=b3b3d14ba7e59e23f7915906236a8e2e13b22249;hpb=f44ecc2f8f07575120aa7a9e3ee3b7bdada42837;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/23dumpmore.t b/t/23dumpmore.t index b3b3d14..a6f5445 100644 --- a/t/23dumpmore.t +++ b/t/23dumpmore.t @@ -1,264 +1,445 @@ +use warnings; use strict; + +use File::Temp (); use Test::More; + use lib qw(t/lib); -use File::Path; -use make_dbictest_db; -require DBIx::Class::Schema::Loader; - -$^O eq 'MSWin32' - ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths") - : plan(tests => 82); - -my $DUMP_PATH = './t/_dump'; - -sub do_dump_test { - my %tdata = @_; - - my $schema_class = $tdata{classname}; - - no strict 'refs'; - @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader'); - $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}}); - - my @warns; - eval { - local $SIG{__WARN__} = sub { push(@warns, @_) }; - $schema_class->connect($make_dbictest_db::dsn); - }; - my $err = $@; - $schema_class->storage->disconnect if !$err && $schema_class->storage; - undef *{$schema_class}; - - is($err, $tdata{error}); - - my $check_warns = $tdata{warnings}; - is(@warns, @$check_warns); - for(my $i = 0; $i <= $#$check_warns; $i++) { - like($warns[$i], $check_warns->[$i]); - } - - my $file_regexes = $tdata{regexes}; - my $file_neg_regexes = $tdata{neg_regexes} || {}; - my $schema_regexes = delete $file_regexes->{schema}; - - my $schema_path = $DUMP_PATH . '/' . $schema_class; - $schema_path =~ s{::}{/}g; - dump_file_like($schema_path . '.pm', @$schema_regexes); - foreach my $src (keys %$file_regexes) { - my $src_file = $schema_path . '/' . $src . '.pm'; - dump_file_like($src_file, @{$file_regexes->{$src}}); - } - foreach my $src (keys %$file_neg_regexes) { - my $src_file = $schema_path . '/' . $src . '.pm'; - dump_file_not_like($src_file, @{$file_neg_regexes->{$src}}); - } -} +use dbixcsl_dumper_tests; +my $t = 'dbixcsl_dumper_tests'; -sub dump_file_like { - my $path = shift; - open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; - my $contents = do { local $/; <$dumpfh>; }; - close($dumpfh); - like($contents, $_) for @_; -} +$t->cleanup; -sub dump_file_not_like { - my $path = shift; - open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; - my $contents = do { local $/; <$dumpfh>; }; - close($dumpfh); - unlike($contents, $_) for @_; -} +# test loading external content +$t->dump_test( + classname => 'DBICTest::Schema::_no_skip_load_external', + warnings => [ + qr/Dumping manual schema for DBICTest::Schema::_no_skip_load_external to directory /, + qr/Schema dump completed/, + ], + regexes => { + Foo => [ + qr/package DBICTest::Schema::_no_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/ + ], + }, +); + +# test skipping external content +$t->dump_test( + classname => 'DBICTest::Schema::_skip_load_external', + options => { + skip_load_external => 1 + }, + warnings => [ + qr/Dumping manual schema for DBICTest::Schema::_skip_load_external to directory /, + qr/Schema dump completed/, + ], + neg_regexes => { + Foo => [ + qr/package DBICTest::Schema::_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/ + ], + }, +); + +$t->cleanup; +# test config_file +{ + my $config_file = File::Temp->new (UNLINK => 1); + + print $config_file "{ skip_relationships => 1 }\n"; + close $config_file; -sub append_to_class { - my ($class, $string) = @_; - $class =~ s{::}{/}g; - $class = $DUMP_PATH . '/' . $class . '.pm'; - open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!"; - print $appendfh $string; - close($appendfh); + $t->dump_test( + classname => 'DBICTest::Schema::_config_file', + options => { config_file => "$config_file" }, + warnings => [ + qr/Dumping manual schema for DBICTest::Schema::_config_file to directory /, + qr/Schema dump completed/, + ], + neg_regexes => { + Foo => [ + qr/has_many/, + ], + }, + ); } -rmtree($DUMP_PATH, 1, 1); +# proper exception +$t->dump_test( + classname => 'DBICTest::Schema::_clashing_monikers', + test_db_class => 'make_dbictest_db_clashing_monikers', + error => qr/tables 'bar', 'bars' reduced to the same source moniker 'Bar'/, +); + -do_dump_test( - classname => 'DBICTest::DumpMore::1', - options => { }, - error => '', +$t->cleanup; + +# test naming => { column_accessors => 'preserve' } +$t->dump_test( + classname => 'DBICTest::Schema::_preserve_column_accessors', + test_db_class => 'make_dbictest_db_with_unique', + options => { naming => { column_accessors => 'preserve' } }, warnings => [ - qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Dumping manual schema for DBICTest::Schema::_preserve_column_accessors to directory /, qr/Schema dump completed/, ], - regexes => { - schema => [ - qr/package DBICTest::DumpMore::1;/, - qr/->load_classes/, - ], - Foo => [ - qr/package DBICTest::DumpMore::1::Foo;/, - qr/->set_primary_key/, - qr/1;\n$/, - ], - Bar => [ - qr/package DBICTest::DumpMore::1::Bar;/, - qr/->set_primary_key/, - qr/1;\n$/, + neg_regexes => { + RouteChange => [ + qr/\baccessor\b/, ], }, ); -append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX}); +$t->cleanup; -do_dump_test( - classname => 'DBICTest::DumpMore::1', - options => { }, - error => '', +# test naming => { monikers => 'plural' } +$t->dump_test( + classname => 'DBICTest::Schema::_plural_monikers', + options => { naming => { monikers => 'plural' } }, warnings => [ - qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Dumping manual schema for DBICTest::Schema::_plural_monikers to directory /, qr/Schema dump completed/, ], regexes => { - schema => [ - qr/package DBICTest::DumpMore::1;/, - qr/->load_classes/, - ], - Foo => [ - qr/package DBICTest::DumpMore::1::Foo;/, - qr/->set_primary_key/, - qr/1;\n# XXX This is my custom content XXX/, + Foos => [ + qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Foos\n\n=cut\n\n/, ], - Bar => [ - qr/package DBICTest::DumpMore::1::Bar;/, - qr/->set_primary_key/, - qr/1;\n$/, + Bars => [ + qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Bars\n\n=cut\n\n/, ], }, ); -do_dump_test( - classname => 'DBICTest::DumpMore::1', - options => { really_erase_my_files => 1 }, - error => '', +$t->cleanup; + +# test naming => { monikers => 'singular' } +$t->dump_test( + classname => 'DBICTest::Schema::_singular_monikers', + test_db_class => 'make_dbictest_db_plural_tables', + options => { naming => { monikers => 'singular' } }, warnings => [ - qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, - qr/Deleting existing file /, - qr/Deleting existing file /, - qr/Deleting existing file /, + qr/Dumping manual schema for DBICTest::Schema::_singular_monikers to directory /, qr/Schema dump completed/, ], regexes => { - schema => [ - qr/package DBICTest::DumpMore::1;/, - qr/->load_classes/, - ], Foo => [ - qr/package DBICTest::DumpMore::1::Foo;/, - qr/->set_primary_key/, - qr/1;\n$/, + qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Foo\n\n=cut\n\n/, ], Bar => [ - qr/package DBICTest::DumpMore::1::Bar;/, - qr/->set_primary_key/, - qr/1;\n$/, - ], - }, - neg_regexes => { - Foo => [ - qr/# XXX This is my custom content XXX/, + qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Bar\n\n=cut\n\n/, ], }, ); -do_dump_test( - classname => 'DBICTest::DumpMore::1', - options => { use_namespaces => 1 }, - error => '', +$t->cleanup; + +# test naming => { monikers => 'preserve' } +$t->dump_test( + classname => 'DBICTest::Schema::_preserve_monikers', + test_db_class => 'make_dbictest_db_plural_tables', + options => { naming => { monikers => 'preserve' } }, warnings => [ - qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Dumping manual schema for DBICTest::Schema::_preserve_monikers to directory /, qr/Schema dump completed/, ], regexes => { - schema => [ - qr/package DBICTest::DumpMore::1;/, - qr/->load_namespaces/, - ], - 'Result/Foo' => [ - qr/package DBICTest::DumpMore::1::Result::Foo;/, - qr/->set_primary_key/, - qr/1;\n$/, + Foos => [ + qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Foos\n\n=cut\n\n/, ], - 'Result/Bar' => [ - qr/package DBICTest::DumpMore::1::Result::Bar;/, - qr/->set_primary_key/, - qr/1;\n$/, + Bars => [ + qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Bars\n\n=cut\n\n/, ], }, ); -do_dump_test( - classname => 'DBICTest::DumpMore::1', - options => { use_namespaces => 1, - result_namespace => 'Res', - resultset_namespace => 'RSet', - default_resultset_class => 'RSetBase', - }, - error => '', - warnings => [ - qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, - qr/Schema dump completed/, - ], - regexes => { - schema => [ - qr/package DBICTest::DumpMore::1;/, - qr/->load_namespaces/, - qr/result_namespace => 'Res'/, - qr/resultset_namespace => 'RSet'/, - qr/default_resultset_class => 'RSetBase'/, - ], - 'Res/Foo' => [ - qr/package DBICTest::DumpMore::1::Res::Foo;/, - qr/->set_primary_key/, - qr/1;\n$/, - ], - 'Res/Bar' => [ - qr/package DBICTest::DumpMore::1::Res::Bar;/, - qr/->set_primary_key/, - qr/1;\n$/, - ], +$t->cleanup; + +# test out the POD +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + custom_column_info => sub { + my ($table, $col, $info) = @_; + return +{ extra => { is_footext => 1 } } if $col eq 'footext'; }, + result_base_class => 'My::ResultBaseClass', + additional_classes => 'TestAdditional', + additional_base_classes => 'TestAdditionalBase', + left_base_classes => 'TestLeftBase', + components => [ 'TestComponent', '+TestComponentFQN' ], + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_classes/, + ], + Foo => [ + qr/package DBICTest::DumpMore::1::Foo;/, + qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\nuse strict;\nuse warnings;\n\n/, + qr/\n=head1 BASE CLASS: L\n\n=cut\n\nuse base 'My::ResultBaseClass';\n\n/, + qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 COMPONENTS LOADED\n\n=over 4\n\n=item \* L\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 ACCESSORS\n\n/, + qr/\n=head2 fooid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 0\n\n/, + qr/\n=head2 footext\n\n data_type: 'text'\n default_value: 'footext'\n extra: {is_footext => 1}\n is_nullable: 1\n\n/, + qr/->set_primary_key/, + qr/\n=head1 RELATIONS\n\n/, + qr/\n=head2 bars\n\nType: has_many\n\nRelated object: L\n\n=cut\n\n/, + qr/1;\n$/, + ], + Bar => [ + qr/package DBICTest::DumpMore::1::Bar;/, + qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\nuse strict;\nuse warnings;\n\n/, + qr/\n=head1 BASE CLASS: L\n\n=cut\n\nuse base 'My::ResultBaseClass';\n\n/, + qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 COMPONENTS LOADED\n\n=over 4\n\n=item \* L\n\n=item \* L\n\n=back\n\n=cut\n\n/, + qr/\n=head1 ACCESSORS\n\n/, + qr/\n=head2 barid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 0\n\n/, + qr/\n=head2 fooref\n\n data_type: 'integer'\n is_foreign_key: 1\n is_nullable: 1\n\n/, + qr/->set_primary_key/, + qr/\n=head1 RELATIONS\n\n/, + qr/\n=head2 fooref\n\nType: belongs_to\n\nRelated object: L\n\n=cut\n\n/, + qr/\n1;\n$/, + ], + }, ); -do_dump_test( - classname => 'DBICTest::DumpMore::1', - options => { use_namespaces => 1, - result_namespace => '+DBICTest::DumpMore::1::Res', - resultset_namespace => 'RSet', - default_resultset_class => 'RSetBase', - }, - error => '', - warnings => [ - qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, - qr/Schema dump completed/, +$t->append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX}); + + +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_classes/, ], - regexes => { - schema => [ - qr/package DBICTest::DumpMore::1;/, - qr/->load_namespaces/, - qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/, - qr/resultset_namespace => 'RSet'/, - qr/default_resultset_class => 'RSetBase'/, - ], - 'Res/Foo' => [ - qr/package DBICTest::DumpMore::1::Res::Foo;/, - qr/->set_primary_key/, - qr/1;\n$/, - ], - 'Res/Bar' => [ - qr/package DBICTest::DumpMore::1::Res::Bar;/, - qr/->set_primary_key/, - qr/1;\n$/, - ], - }, + Foo => [ + qr/package DBICTest::DumpMore::1::Foo;/, + qr/->set_primary_key/, + qr/1;\n# XXX This is my custom content XXX/, + ], + Bar => [ + qr/package DBICTest::DumpMore::1::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + + +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + really_erase_my_files => 1 + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Deleting existing file /, + qr/Deleting existing file /, + qr/Deleting existing file /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_classes/, + ], + Foo => [ + qr/package DBICTest::DumpMore::1::Foo;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + Bar => [ + qr/package DBICTest::DumpMore::1::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, + neg_regexes => { + Foo => [ + qr/# XXX This is my custom content XXX/, + ], + }, +); + + +$t->cleanup; + +# test namespaces +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_namespaces => 1, + generate_pod => 0 + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + neg_regexes => { + 'Result/Foo' => [ + qr/^=/m, + ], + }, +); + + +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + db_schema => 'foo_schema', + qualify_objects => 1, + use_namespaces => 1 + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + 'Result/Foo' => [ + qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m, + # the has_many relname should not have the schema in it! + qr/^__PACKAGE__->has_many\(\n "bars"/m, + ], + }, +); + +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_namespaces => 1 + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_namespaces/, + ], + 'Result/Foo' => [ + qr/package DBICTest::DumpMore::1::Result::Foo;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + 'Result/Bar' => [ + qr/package DBICTest::DumpMore::1::Result::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + + +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_namespaces => 1, + result_namespace => 'Res', + resultset_namespace => 'RSet', + default_resultset_class => 'RSetBase', + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_namespaces/, + qr/result_namespace => 'Res'/, + qr/resultset_namespace => 'RSet'/, + qr/default_resultset_class => 'RSetBase'/, + ], + 'Res/Foo' => [ + qr/package DBICTest::DumpMore::1::Res::Foo;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + 'Res/Bar' => [ + qr/package DBICTest::DumpMore::1::Res::Bar;/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + + +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_namespaces => 1, + result_namespace => '+DBICTest::DumpMore::1::Res', + resultset_namespace => 'RSet', + default_resultset_class => 'RSetBase', + result_base_class => 'My::ResultBaseClass', + schema_base_class => 'My::SchemaBaseClass', + }, + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], + regexes => { + schema => [ + qr/package DBICTest::DumpMore::1;/, + qr/->load_namespaces/, + qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/, + qr/resultset_namespace => 'RSet'/, + qr/default_resultset_class => 'RSetBase'/, + qr/use base 'My::SchemaBaseClass'/, + ], + 'Res/Foo' => [ + qr/package DBICTest::DumpMore::1::Res::Foo;/, + qr/use base 'My::ResultBaseClass'/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + 'Res/Bar' => [ + qr/package DBICTest::DumpMore::1::Res::Bar;/, + qr/use base 'My::ResultBaseClass'/, + qr/->set_primary_key/, + qr/1;\n$/, + ], + }, +); + + +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_namespaces => 1, + result_base_class => 'My::MissingResultBaseClass', + }, + error => qr/My::MissingResultBaseClass.*is not installed/, +); + +# test quote_char in connect_info for dbicdump +$t->dump_test( + classname => 'DBICTest::DumpMore::1', + extra_connect_info => [ + '', + '', + { quote_char => '"' }, + ], + warnings => [ + qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, + qr/Schema dump completed/, + ], ); -END { rmtree($DUMP_PATH, 1, 1); } +done_testing; +# vim:et sts=4 sw=4 tw=0: