1use strict; 2use Test::More tests => 3; 3use Test::Exception; 4use lib qw(t/lib); 5use make_dbictest_db; 6 7use File::Copy; 8use File::Spec; 9use File::Temp qw/ tempdir tempfile /; 10 11use DBIx::Class::Schema::Loader; 12 13my $tempdir = tempdir( CLEANUP => 1 ); 14my $foopm = File::Spec->catfile( $tempdir, 15 qw| DBICTest Schema Overwrite_modifications Result Foo.pm |); 16dump_schema(); 17 18# check that we dumped 19ok( -f $foopm, 'looks like it dumped' ); 20 21# now modify one of the files 22{ 23 open my $in, '<', $foopm or die "$! reading $foopm"; 24 my ($tfh,$temp) = tempfile( UNLINK => 1); 25 while(<$in>) { 26 s/"bars"/"somethingelse"/; 27 print $tfh $_; 28 } 29 close $tfh; 30 copy( $temp, $foopm ); 31} 32 33# and dump again without overwrites 34throws_ok { 35 dump_schema(); 36} qr/mismatch/, 'throws error dumping without overwrite_modifications'; 37 38# and then dump with overwrite 39lives_ok { 40 dump_schema( overwrite_modifications => 1 ); 41} 'does not throw when dumping with overwrite_modifications'; 42 43sub dump_schema { 44 45 # need to poke _loader_invoked in order to be able to rerun the 46 # loader multiple times. 47 DBICTest::Schema::Overwrite_modifications->_loader_invoked(0) 48 if @DBICTest::Schema::Overwrite_modifications::ISA; 49 50 local $SIG{__WARN__} = sub { 51 warn @_ 52 unless $_[0] =~ /^Dumping manual schema|^Schema dump completed/; 53 }; 54 DBIx::Class::Schema::Loader::make_schema_at( 'DBICTest::Schema::Overwrite_modifications', 55 { dump_directory => $tempdir, 56 @_, 57 }, 58 [ $make_dbictest_db::dsn ], 59 ); 60} 61