X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F23dumpmore.t;h=c02c27913dbe84815e1fb1fad4064639cc9ec80a;hb=4f3ff924f36e5f893c3e75d9703a4f619eb31a41;hp=57bd2069543a07240e7d5d0277d453dac6dcb86f;hpb=6dde461399e3aaf3a24f1b21510fb9f2fd1ef5b1;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/23dumpmore.t b/t/23dumpmore.t index 57bd206..c02c279 100644 --- a/t/23dumpmore.t +++ b/t/23dumpmore.t @@ -1,13 +1,16 @@ use strict; use Test::More; -use lib qw(t/lib); use File::Path; use IPC::Open3; -use make_dbictest_db; -require DBIx::Class::Schema::Loader; +use Data::Dumper::Concise; +use DBIx::Class::Schema::Loader (); +use File::Temp 'tempfile'; +use lib qw(t/lib); my $DUMP_PATH = './t/_dump'; +my $TEST_DB_CLASS = 'make_dbictest_db'; + sub dump_directly { my %tdata = @_; @@ -20,13 +23,13 @@ sub dump_directly { my @warns; eval { local $SIG{__WARN__} = sub { push(@warns, @_) }; - $schema_class->connect($make_dbictest_db::dsn); + $schema_class->connect(get_dsn(\%tdata)); }; my $err = $@; $schema_class->storage->disconnect if !$err && $schema_class->storage; undef *{$schema_class}; - is($err, $tdata{error}); + check_error($err, $tdata{error}); return @warns; } @@ -38,24 +41,64 @@ sub dump_dbicdump { my @cmd = ($^X, qw(./script/dbicdump)); while (my ($opt, $val) = each(%{ $tdata{options} })) { + $val = Dumper($val) if ref $val; push @cmd, '-o', "$opt=$val"; } - push @cmd, $tdata{classname}, $make_dbictest_db::dsn; + push @cmd, $tdata{classname}, get_dsn(\%tdata); # make sure our current @INC gets used by dbicdump use Config; - local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, $ENV{PERL5LIB}; + local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, ($ENV{PERL5LIB} || ''); my ($in, $out, $err); my $pid = open3($in, $out, $err, @cmd); - my @warns = <$out>; + my @out = <$out>; waitpid($pid, 0); + my ($error, @warns); + + if ($? >> 8 != 0) { + $error = $out[0]; + check_error($error, $tdata{error}); + } + else { + @warns = @out; + } + return @warns; } +sub get_dsn { + my $opts = shift; + + my $test_db_class = $opts->{test_db_class} || $TEST_DB_CLASS; + + eval "require $test_db_class;"; + die $@ if $@; + + my $dsn = do { + no strict 'refs'; + ${$test_db_class . '::dsn'}; + }; + + return $dsn; +} + +sub check_error { + my ($got, $expected) = @_; + + return unless $got && $expected; + + if (ref $expected eq 'Regexp') { + like $got, $expected, 'error matches expected pattern'; + return; + } + + is $got, $expected, 'error matches'; +} + sub do_dump_test { my %tdata = @_; @@ -75,6 +118,7 @@ sub test_dumps { my $schema_class = $tdata{classname}; my $check_warns = $tdata{warnings}; is(@warns, @$check_warns, "$schema_class warning count"); + for(my $i = 0; $i <= $#$check_warns; $i++) { like($warns[$i], $check_warns->[$i], "$schema_class warning $i"); } @@ -85,7 +129,9 @@ sub test_dumps { my $schema_path = $DUMP_PATH . '/' . $schema_class; $schema_path =~ s{::}{/}g; - dump_file_like($schema_path . '.pm', @$schema_regexes); + + dump_file_like($schema_path . '.pm', @$schema_regexes) if $schema_regexes; + foreach my $src (keys %$file_regexes) { my $src_file = $schema_path . '/' . $src . '.pm'; dump_file_like($src_file, @{$file_regexes->{$src}}); @@ -128,8 +174,6 @@ rmtree($DUMP_PATH, 1, 1); # test loading external content do_dump_test( classname => 'DBICTest::Schema::13', - options => { }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::Schema::13 to directory /, qr/Schema dump completed/, @@ -145,7 +189,6 @@ qr/package DBICTest::Schema::13::Foo;\nour \$skip_me = "bad mojo";\n1;/ do_dump_test( classname => 'DBICTest::Schema::14', options => { skip_load_external => 1 }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::Schema::14 to directory /, qr/Schema dump completed/, @@ -159,12 +202,51 @@ qr/package DBICTest::Schema::14::Foo;\nour \$skip_me = "bad mojo";\n1;/ rmtree($DUMP_PATH, 1, 1); +# test config_file + +my ($fh, $config_file) = tempfile; + +print $fh <<'EOF'; +{ skip_relationships => 1 } +EOF +close $fh; + +do_dump_test( + classname => 'DBICTest::Schema::14', + options => { config_file => $config_file }, + warnings => [ + qr/Dumping manual schema for DBICTest::Schema::14 to directory /, + qr/Schema dump completed/, + ], + neg_regexes => { + Foo => [ + qr/has_many/, + ], + }, +); + +unlink $config_file; + +rmtree($DUMP_PATH, 1, 1); + +do_dump_test( + classname => 'DBICTest::Schema::14', + test_db_class => 'make_dbictest_db_clashing_monikers', + error => qr/tables 'bar', 'bars' reduced to the same source moniker 'Bar'/, +); + +rmtree($DUMP_PATH, 1, 1); + # test out the POD do_dump_test( classname => 'DBICTest::DumpMore::1', - options => { }, - error => '', + options => { + custom_column_info => sub { + my ($table, $col, $info) = @_; + return +{ extra => { is_footext => 1 } } if $col eq 'footext'; + } + }, warnings => [ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, qr/Schema dump completed/, @@ -178,8 +260,8 @@ do_dump_test( qr/package DBICTest::DumpMore::1::Foo;/, qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/, qr/=head1 ACCESSORS\n\n/, -qr/=head2 fooid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/, -qr/=head2 footext\n\n data_type: TEXT\n default_value: undef\n is_nullable: 1\n size: undef\n\n/, +qr/=head2 fooid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 1\n\n/, +qr/=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/=head1 RELATIONS\n\n/, qr/=head2 bars\n\nType: has_many\n\nRelated object: L\n\n=cut\n\n/, @@ -189,8 +271,8 @@ qr/1;\n$/, qr/package DBICTest::DumpMore::1::Bar;/, qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/, qr/=head1 ACCESSORS\n\n/, -qr/=head2 barid\n\n data_type: INTEGER\n default_value: undef\n is_nullable: 1\n size: undef\n\n/, -qr/=head2 fooref\n\n data_type: INTEGER\n default_value: undef\n is_foreign_key: 1\n is_nullable: 1\n size: undef\n\n/, +qr/=head2 barid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 1\n\n/, +qr/=head2 fooref\n\n data_type: 'integer'\n is_foreign_key: 1\n is_nullable: 1\n\n/, qr/->set_primary_key/, qr/=head1 RELATIONS\n\n/, qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L\n\n=cut\n\n/, @@ -203,8 +285,6 @@ append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content X do_dump_test( classname => 'DBICTest::DumpMore::1', - options => { }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, qr/Schema dump completed/, @@ -230,7 +310,6 @@ do_dump_test( do_dump_test( classname => 'DBICTest::DumpMore::1', options => { really_erase_my_files => 1 }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, qr/Deleting existing file /, @@ -261,10 +340,11 @@ do_dump_test( }, ); +rmtree($DUMP_PATH, 1, 1); + do_dump_test( classname => 'DBICTest::DumpMore::1', options => { use_namespaces => 1, generate_pod => 0 }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, qr/Schema dump completed/, @@ -276,10 +356,27 @@ do_dump_test( }, ); +rmtree($DUMP_PATH, 1, 1); + +do_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, + ], + }, +); + +rmtree($DUMP_PATH, 1, 1); + do_dump_test( classname => 'DBICTest::DumpMore::1', options => { use_namespaces => 1 }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, qr/Schema dump completed/, @@ -302,6 +399,8 @@ do_dump_test( }, ); +rmtree($DUMP_PATH, 1, 1); + do_dump_test( classname => 'DBICTest::DumpMore::1', options => { use_namespaces => 1, @@ -309,7 +408,6 @@ do_dump_test( resultset_namespace => 'RSet', default_resultset_class => 'RSetBase', }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, qr/Schema dump completed/, @@ -335,6 +433,8 @@ do_dump_test( }, ); +rmtree($DUMP_PATH, 1, 1); + do_dump_test( classname => 'DBICTest::DumpMore::1', options => { use_namespaces => 1, @@ -344,7 +444,6 @@ do_dump_test( result_base_class => 'My::ResultBaseClass', schema_base_class => 'My::SchemaBaseClass', }, - error => '', warnings => [ qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, qr/Schema dump completed/, @@ -373,6 +472,18 @@ do_dump_test( }, ); +rmtree($DUMP_PATH, 1, 1); + +do_dump_test( + classname => 'DBICTest::DumpMore::1', + options => { + use_namespaces => 1, + result_base_class => 'My::MissingResultBaseClass', + }, + error => qr/My::MissingResultBaseClass.*is not installed/, +); + done_testing; END { rmtree($DUMP_PATH, 1, 1) unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} } +# vim:et sts=4 sw=4 tw=0: