t/40overwrite_modifications.t

   1 use strict;
   2 use warnings;
   3 use Test::More;
   4 use Test::Exception;
   5 use Test::Warn;
   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;
  14 use DBIx::Class::Schema::Loader::Utils qw/ slurp_file /;
  15
  16 my $tempdir = tempdir( CLEANUP => 1 );
  17 my $foopm = File::Spec->catfile( $tempdir,
  18     qw| DBICTest Schema Overwrite_modifications Result Foo.pm |);
  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
  25 rewrite_file($foopm, qr{"bars"}, q{"somethingelse"});
  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
  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';
  49
  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 );
  68
  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)
  74         if @DBICTest::Schema::Overwrite_modifications::ISA;
  75
  76     my $args = \@_;
  77
  78     warnings_exist {
  79         DBIx::Class::Schema::Loader::make_schema_at( 'DBICTest::Schema::Overwrite_modifications',
  80             { dump_directory => $tempdir, @$args },
  81             [ $make_dbictest_db::dsn ],
  82         );
  83     } [qr/^Dumping manual schema/, qr/^Schema dump completed/ ],
  84     'schema was dumped with expected warnings';
  85 }
  86
  87 sub rewrite_file {
  88     my ($file, $match, $replace) = @_;
  89
  90     open my $in, '<', $file or die "$! reading $file";
  91     my ($tfh, $temp) = tempfile( UNLINK => 1 );
  92     while(<$in>) {
  93         s/$match/$replace/;
  94         print $tfh $_;
  95     }
  96     close $tfh;
  97     copy( $temp, $file );
  98 }
  99
 100 done_testing();