Commit | Line | Data |
9cb983b3 |
1 | use strict; |
f8c2ca5e |
2 | use warnings; |
c939b4ac |
3 | use Test::More; |
9cb983b3 |
4 | use Test::Exception; |
c38ec663 |
5 | use Test::Warn; |
9cb983b3 |
6 | use lib qw(t/lib); |
7 | use make_dbictest_db; |
8 | |
9 | use File::Copy; |
10 | use File::Spec; |
11 | use File::Temp qw/ tempdir tempfile /; |
12 | |
13 | use DBIx::Class::Schema::Loader; |
c939b4ac |
14 | use DBIx::Class::Schema::Loader::Utils qw/ slurp_file /; |
9cb983b3 |
15 | |
16 | my $tempdir = tempdir( CLEANUP => 1 ); |
f22644d7 |
17 | my $foopm = File::Spec->catfile( $tempdir, |
18 | qw| DBICTest Schema Overwrite_modifications Result Foo.pm |); |
9cb983b3 |
19 | dump_schema(); |
20 | |
21 | # check that we dumped |
22 | ok( -f $foopm, 'looks like it dumped' ); |
23 | |
24 | # now modify one of the files |
348abad2 |
25 | rewrite_file($foopm, qr{"bars"}, q{"somethingelse"}); |
9cb983b3 |
26 | |
27 | # and dump again without overwrites |
28 | throws_ok { |
29 | dump_schema(); |
30 | } qr/mismatch/, 'throws error dumping without overwrite_modifications'; |
31 | |
32 | # and then dump with overwrite |
33 | lives_ok { |
34 | dump_schema( overwrite_modifications => 1 ); |
35 | } 'does not throw when dumping with overwrite_modifications'; |
36 | |
348abad2 |
37 | # Replace the md5 with a bad MD5 in Foo.pm |
38 | my $foopm_content = slurp_file($foopm); |
39 | my ($md5) = $foopm_content =~/md5sum:(.+)$/m; |
40 | # This cannot be just any arbitrary value, it has to actually look like an MD5 |
41 | # value or DBICSL doesn't even see it as an MD5 at all (which makes sense). |
42 | my $bad_md5 = reverse $md5; |
43 | rewrite_file($foopm, qr{md5sum:.+$}, "md5sum:$bad_md5"); |
44 | |
45 | # and dump again without overwrites |
46 | throws_ok { |
47 | dump_schema(); |
48 | } qr/mismatch/, 'throws error dumping without overwrite_modifications'; |
c939b4ac |
49 | |
348abad2 |
50 | $foopm_content = slurp_file($foopm); |
51 | like( |
52 | $foopm_content, |
53 | qr/\Q$bad_md5/, |
54 | 'bad MD5 is not rewritten when overwrite_modifications is false' |
55 | ); |
56 | |
57 | # and then dump with overwrite |
58 | lives_ok { |
59 | dump_schema( overwrite_modifications => 1 ); |
60 | } 'does not throw when dumping with overwrite_modifications'; |
61 | |
62 | $foopm_content = slurp_file($foopm); |
63 | unlike( |
64 | $foopm_content, |
65 | qr/\Q$bad_md5/, |
66 | 'bad MD5 is rewritten when overwrite_modifications is true' |
67 | ); |
c939b4ac |
68 | |
9cb983b3 |
69 | sub dump_schema { |
70 | |
71 | # need to poke _loader_invoked in order to be able to rerun the |
72 | # loader multiple times. |
73 | DBICTest::Schema::Overwrite_modifications->_loader_invoked(0) |
c38ec663 |
74 | if @DBICTest::Schema::Overwrite_modifications::ISA; |
75 | |
76 | my $args = \@_; |
77 | |
78 | warnings_exist { |
c2fa1a57 |
79 | DBIx::Class::Schema::Loader::make_schema_at( |
80 | 'DBICTest::Schema::Overwrite_modifications', |
c38ec663 |
81 | { dump_directory => $tempdir, @$args }, |
82 | [ $make_dbictest_db::dsn ], |
83 | ); |
348abad2 |
84 | } [qr/^Dumping manual schema/, qr/^Schema dump completed/ ], |
85 | 'schema was dumped with expected warnings'; |
86 | } |
87 | |
88 | sub rewrite_file { |
89 | my ($file, $match, $replace) = @_; |
90 | |
91 | open my $in, '<', $file or die "$! reading $file"; |
92 | my ($tfh, $temp) = tempfile( UNLINK => 1 ); |
93 | while(<$in>) { |
94 | s/$match/$replace/; |
95 | print $tfh $_; |
96 | } |
97 | close $tfh; |
98 | copy( $temp, $file ); |
9cb983b3 |
99 | } |
c939b4ac |
100 | |
101 | done_testing(); |