Commit | Line | Data |
605fcea8 |
1 | use strict; |
2 | use Test::More; |
3 | use lib qw(t/lib); |
4 | use File::Path; |
ff746964 |
5 | use IPC::Open3; |
605fcea8 |
6 | use make_dbictest_db; |
7 | require DBIx::Class::Schema::Loader; |
8 | |
12c918bd |
9 | $^O eq 'MSWin32' |
10 | ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths") |
6c7e99db |
11 | : plan(tests => 143); |
605fcea8 |
12 | |
a4187fdf |
13 | my $DUMP_PATH = './t/_dump'; |
605fcea8 |
14 | |
ff746964 |
15 | sub dump_directly { |
a4187fdf |
16 | my %tdata = @_; |
605fcea8 |
17 | |
a4187fdf |
18 | my $schema_class = $tdata{classname}; |
605fcea8 |
19 | |
20 | no strict 'refs'; |
21 | @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader'); |
ff746964 |
22 | $schema_class->loader_options(%{$tdata{options}}); |
605fcea8 |
23 | |
a4187fdf |
24 | my @warns; |
605fcea8 |
25 | eval { |
a4187fdf |
26 | local $SIG{__WARN__} = sub { push(@warns, @_) }; |
605fcea8 |
27 | $schema_class->connect($make_dbictest_db::dsn); |
28 | }; |
29 | my $err = $@; |
30 | $schema_class->storage->disconnect if !$err && $schema_class->storage; |
31 | undef *{$schema_class}; |
a4187fdf |
32 | |
33 | is($err, $tdata{error}); |
34 | |
ff746964 |
35 | return @warns; |
36 | } |
37 | |
38 | sub dump_dbicdump { |
39 | my %tdata = @_; |
40 | |
41 | my @cmd = qw(./script/dbicdump); |
42 | |
43 | while (my ($opt, $val) = each(%{ $tdata{options} })) { |
44 | push @cmd, '-o', "$opt=$val"; |
45 | } |
46 | |
47 | push @cmd, $tdata{classname}, $make_dbictest_db::dsn; |
48 | |
49 | my ($in, $out, $err); |
50 | my $pid = open3($in, $out, $err, @cmd); |
51 | |
52 | my @warns = <$out>; |
53 | waitpid($pid, 0); |
54 | |
55 | return @warns; |
56 | } |
57 | |
58 | sub do_dump_test { |
59 | my %tdata = @_; |
60 | |
61 | $tdata{options}{dump_directory} = $DUMP_PATH; |
62 | |
63 | for my $dumper (\&dump_directly, \&dump_dbicdump) { |
64 | test_dumps(\%tdata, $dumper->(%tdata)); |
65 | } |
66 | } |
67 | |
68 | sub test_dumps { |
69 | my ($tdata, @warns) = @_; |
70 | |
71 | my %tdata = %{$tdata}; |
72 | |
73 | my $schema_class = $tdata{classname}; |
a4187fdf |
74 | my $check_warns = $tdata{warnings}; |
ff746964 |
75 | is(@warns, @$check_warns, "$schema_class warning count"); |
a4187fdf |
76 | for(my $i = 0; $i <= $#$check_warns; $i++) { |
ff746964 |
77 | like($warns[$i], $check_warns->[$i], "$schema_class warning $i"); |
a4187fdf |
78 | } |
79 | |
80 | my $file_regexes = $tdata{regexes}; |
81 | my $file_neg_regexes = $tdata{neg_regexes} || {}; |
82 | my $schema_regexes = delete $file_regexes->{schema}; |
83 | |
84 | my $schema_path = $DUMP_PATH . '/' . $schema_class; |
85 | $schema_path =~ s{::}{/}g; |
86 | dump_file_like($schema_path . '.pm', @$schema_regexes); |
87 | foreach my $src (keys %$file_regexes) { |
88 | my $src_file = $schema_path . '/' . $src . '.pm'; |
89 | dump_file_like($src_file, @{$file_regexes->{$src}}); |
90 | } |
91 | foreach my $src (keys %$file_neg_regexes) { |
92 | my $src_file = $schema_path . '/' . $src . '.pm'; |
93 | dump_file_not_like($src_file, @{$file_neg_regexes->{$src}}); |
94 | } |
605fcea8 |
95 | } |
96 | |
a4187fdf |
97 | sub dump_file_like { |
98 | my $path = shift; |
99 | open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; |
100 | my $contents = do { local $/; <$dumpfh>; }; |
101 | close($dumpfh); |
ff746964 |
102 | my $num = 1; |
103 | like($contents, $_, "like $path " . $num++) for @_; |
a4187fdf |
104 | } |
605fcea8 |
105 | |
a4187fdf |
106 | sub dump_file_not_like { |
107 | my $path = shift; |
108 | open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!"; |
109 | my $contents = do { local $/; <$dumpfh>; }; |
110 | close($dumpfh); |
ff746964 |
111 | my $num = 1; |
112 | unlike($contents, $_, "unlike $path ". $num++) for @_; |
605fcea8 |
113 | } |
114 | |
a4187fdf |
115 | sub append_to_class { |
116 | my ($class, $string) = @_; |
117 | $class =~ s{::}{/}g; |
118 | $class = $DUMP_PATH . '/' . $class . '.pm'; |
119 | open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!"; |
120 | print $appendfh $string; |
121 | close($appendfh); |
122 | } |
123 | |
124 | rmtree($DUMP_PATH, 1, 1); |
125 | |
126 | do_dump_test( |
127 | classname => 'DBICTest::DumpMore::1', |
128 | options => { }, |
129 | error => '', |
130 | warnings => [ |
131 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
132 | qr/Schema dump completed/, |
133 | ], |
134 | regexes => { |
135 | schema => [ |
136 | qr/package DBICTest::DumpMore::1;/, |
137 | qr/->load_classes/, |
138 | ], |
139 | Foo => [ |
140 | qr/package DBICTest::DumpMore::1::Foo;/, |
141 | qr/->set_primary_key/, |
142 | qr/1;\n$/, |
143 | ], |
144 | Bar => [ |
145 | qr/package DBICTest::DumpMore::1::Bar;/, |
146 | qr/->set_primary_key/, |
147 | qr/1;\n$/, |
148 | ], |
149 | }, |
150 | ); |
151 | |
152 | append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX}); |
153 | |
154 | do_dump_test( |
155 | classname => 'DBICTest::DumpMore::1', |
156 | options => { }, |
157 | error => '', |
158 | warnings => [ |
159 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
160 | qr/Schema dump completed/, |
161 | ], |
162 | regexes => { |
163 | schema => [ |
164 | qr/package DBICTest::DumpMore::1;/, |
165 | qr/->load_classes/, |
166 | ], |
167 | Foo => [ |
168 | qr/package DBICTest::DumpMore::1::Foo;/, |
169 | qr/->set_primary_key/, |
170 | qr/1;\n# XXX This is my custom content XXX/, |
171 | ], |
172 | Bar => [ |
173 | qr/package DBICTest::DumpMore::1::Bar;/, |
174 | qr/->set_primary_key/, |
175 | qr/1;\n$/, |
176 | ], |
177 | }, |
178 | ); |
605fcea8 |
179 | |
a4187fdf |
180 | do_dump_test( |
181 | classname => 'DBICTest::DumpMore::1', |
28b4691d |
182 | options => { really_erase_my_files => 1 }, |
a4187fdf |
183 | error => '', |
184 | warnings => [ |
185 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
186 | qr/Deleting existing file /, |
187 | qr/Deleting existing file /, |
188 | qr/Deleting existing file /, |
189 | qr/Schema dump completed/, |
190 | ], |
191 | regexes => { |
192 | schema => [ |
193 | qr/package DBICTest::DumpMore::1;/, |
194 | qr/->load_classes/, |
195 | ], |
196 | Foo => [ |
197 | qr/package DBICTest::DumpMore::1::Foo;/, |
198 | qr/->set_primary_key/, |
199 | qr/1;\n$/, |
200 | ], |
201 | Bar => [ |
202 | qr/package DBICTest::DumpMore::1::Bar;/, |
203 | qr/->set_primary_key/, |
204 | qr/1;\n$/, |
205 | ], |
206 | }, |
207 | neg_regexes => { |
208 | Foo => [ |
209 | qr/# XXX This is my custom content XXX/, |
210 | ], |
211 | }, |
212 | ); |
605fcea8 |
213 | |
f44ecc2f |
214 | do_dump_test( |
215 | classname => 'DBICTest::DumpMore::1', |
216 | options => { use_namespaces => 1 }, |
217 | error => '', |
218 | warnings => [ |
219 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
220 | qr/Schema dump completed/, |
221 | ], |
222 | regexes => { |
223 | schema => [ |
224 | qr/package DBICTest::DumpMore::1;/, |
225 | qr/->load_namespaces/, |
226 | ], |
227 | 'Result/Foo' => [ |
228 | qr/package DBICTest::DumpMore::1::Result::Foo;/, |
229 | qr/->set_primary_key/, |
230 | qr/1;\n$/, |
231 | ], |
232 | 'Result/Bar' => [ |
233 | qr/package DBICTest::DumpMore::1::Result::Bar;/, |
234 | qr/->set_primary_key/, |
235 | qr/1;\n$/, |
236 | ], |
237 | }, |
238 | ); |
239 | |
240 | do_dump_test( |
241 | classname => 'DBICTest::DumpMore::1', |
242 | options => { use_namespaces => 1, |
243 | result_namespace => 'Res', |
244 | resultset_namespace => 'RSet', |
245 | default_resultset_class => 'RSetBase', |
246 | }, |
247 | error => '', |
248 | warnings => [ |
249 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
250 | qr/Schema dump completed/, |
251 | ], |
252 | regexes => { |
253 | schema => [ |
254 | qr/package DBICTest::DumpMore::1;/, |
255 | qr/->load_namespaces/, |
256 | qr/result_namespace => 'Res'/, |
257 | qr/resultset_namespace => 'RSet'/, |
258 | qr/default_resultset_class => 'RSetBase'/, |
259 | ], |
260 | 'Res/Foo' => [ |
261 | qr/package DBICTest::DumpMore::1::Res::Foo;/, |
262 | qr/->set_primary_key/, |
263 | qr/1;\n$/, |
264 | ], |
265 | 'Res/Bar' => [ |
266 | qr/package DBICTest::DumpMore::1::Res::Bar;/, |
267 | qr/->set_primary_key/, |
268 | qr/1;\n$/, |
269 | ], |
270 | }, |
271 | ); |
272 | |
273 | do_dump_test( |
274 | classname => 'DBICTest::DumpMore::1', |
275 | options => { use_namespaces => 1, |
276 | result_namespace => '+DBICTest::DumpMore::1::Res', |
277 | resultset_namespace => 'RSet', |
278 | default_resultset_class => 'RSetBase', |
9c9c2f2b |
279 | result_base_class => 'My::ResultBaseClass', |
280 | schema_base_class => 'My::SchemaBaseClass', |
f44ecc2f |
281 | }, |
282 | error => '', |
283 | warnings => [ |
284 | qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /, |
285 | qr/Schema dump completed/, |
286 | ], |
287 | regexes => { |
288 | schema => [ |
289 | qr/package DBICTest::DumpMore::1;/, |
290 | qr/->load_namespaces/, |
291 | qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/, |
292 | qr/resultset_namespace => 'RSet'/, |
293 | qr/default_resultset_class => 'RSetBase'/, |
9c9c2f2b |
294 | qr/use base 'My::SchemaBaseClass'/, |
f44ecc2f |
295 | ], |
296 | 'Res/Foo' => [ |
297 | qr/package DBICTest::DumpMore::1::Res::Foo;/, |
9c9c2f2b |
298 | qr/use base 'My::ResultBaseClass'/, |
f44ecc2f |
299 | qr/->set_primary_key/, |
300 | qr/1;\n$/, |
301 | ], |
302 | 'Res/Bar' => [ |
303 | qr/package DBICTest::DumpMore::1::Res::Bar;/, |
9c9c2f2b |
304 | qr/use base 'My::ResultBaseClass'/, |
f44ecc2f |
305 | qr/->set_primary_key/, |
306 | qr/1;\n$/, |
307 | ], |
308 | }, |
309 | ); |
310 | |
a4187fdf |
311 | END { rmtree($DUMP_PATH, 1, 1); } |