6 require DBIx::Class::Schema::Loader;
10 plan skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths"
11 if ($^O eq 'MSWin32');
13 my $DUMP_PATH = './t/_dump';
18 my $schema_class = $tdata{classname};
21 @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
22 $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}});
26 local $SIG{__WARN__} = sub { push(@warns, @_) };
27 $schema_class->connect($make_dbictest_db::dsn);
30 $schema_class->storage->disconnect if !$err && $schema_class->storage;
31 undef *{$schema_class};
33 is($err, $tdata{error});
35 my $check_warns = $tdata{warnings};
36 is(@warns, @$check_warns);
37 for(my $i = 0; $i <= $#$check_warns; $i++) {
38 like($warns[$i], $check_warns->[$i]);
41 my $file_regexes = $tdata{regexes};
42 my $file_neg_regexes = $tdata{neg_regexes} || {};
43 my $schema_regexes = delete $file_regexes->{schema};
45 my $schema_path = $DUMP_PATH . '/' . $schema_class;
46 $schema_path =~ s{::}{/}g;
47 dump_file_like($schema_path . '.pm', @$schema_regexes);
48 foreach my $src (keys %$file_regexes) {
49 my $src_file = $schema_path . '/' . $src . '.pm';
50 dump_file_like($src_file, @{$file_regexes->{$src}});
52 foreach my $src (keys %$file_neg_regexes) {
53 my $src_file = $schema_path . '/' . $src . '.pm';
54 dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
60 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
61 my $contents = do { local $/; <$dumpfh>; };
63 like($contents, $_) for @_;
66 sub dump_file_not_like {
68 open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
69 my $contents = do { local $/; <$dumpfh>; };
71 unlike($contents, $_) for @_;
75 my ($class, $string) = @_;
77 $class = $DUMP_PATH . '/' . $class . '.pm';
78 open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
79 print $appendfh $string;
83 rmtree($DUMP_PATH, 1, 1);
86 classname => 'DBICTest::DumpMore::1',
90 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
91 qr/Schema dump completed/,
95 qr/package DBICTest::DumpMore::1;/,
99 qr/package DBICTest::DumpMore::1::Foo;/,
100 qr/->set_primary_key/,
104 qr/package DBICTest::DumpMore::1::Bar;/,
105 qr/->set_primary_key/,
111 append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
114 classname => 'DBICTest::DumpMore::1',
118 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
119 qr/Schema dump completed/,
123 qr/package DBICTest::DumpMore::1;/,
127 qr/package DBICTest::DumpMore::1::Foo;/,
128 qr/->set_primary_key/,
129 qr/1;\n# XXX This is my custom content XXX/,
132 qr/package DBICTest::DumpMore::1::Bar;/,
133 qr/->set_primary_key/,
140 classname => 'DBICTest::DumpMore::1',
141 options => { dump_overwrite => 1 },
144 qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
145 qr/Deleting existing file /,
146 qr/Deleting existing file /,
147 qr/Deleting existing file /,
148 qr/Schema dump completed/,
152 qr/package DBICTest::DumpMore::1;/,
156 qr/package DBICTest::DumpMore::1::Foo;/,
157 qr/->set_primary_key/,
161 qr/package DBICTest::DumpMore::1::Bar;/,
162 qr/->set_primary_key/,
168 qr/# XXX This is my custom content XXX/,
173 END { rmtree($DUMP_PATH, 1, 1); }