t/22dump.t

   1 use strict;
   2 use Test::More;
   3 use Test::Exception;
   4 use Test::Warn;
   5 use lib qw(t/lib);
   6 use File::Path;
   7 use make_dbictest_db;
   8 use dbixcsl_test_dir qw/$tdir/;
   9
  10 my $dump_path = "$tdir/dump";
  11
  12
  13 {
  14     package DBICTest::Schema::1;
  15     use base qw/ DBIx::Class::Schema::Loader /;
  16     __PACKAGE__->loader_options(
  17         dump_directory => $dump_path,
  18     );
  19 }
  20
  21 {
  22     package DBICTest::Schema::2;
  23     use base qw/ DBIx::Class::Schema::Loader /;
  24     __PACKAGE__->loader_options(
  25         dump_directory => $dump_path,
  26         really_erase_my_files => 1,
  27     );
  28 }
  29
  30 plan tests => 7;
  31
  32 rmtree($dump_path, 1, 1);
  33
  34 lives_ok {
  35   warnings_exist { DBICTest::Schema::1->connect($make_dbictest_db::dsn) }
  36     [ qr|^Dumping manual schema|, qr|^Schema dump completed| ];
  37 } 'no death with dump_directory set' or diag "Dump failed: $@";
  38
  39 DBICTest::Schema::1->_loader_invoked(undef);
  40
  41 SKIP: {
  42   skip "ActiveState perl produces additional warnings", 1
  43     if ($^O eq 'MSWin32');
  44
  45   warnings_exist { DBICTest::Schema::1->connect($make_dbictest_db::dsn) }
  46     [ qr|^Dumping manual schema|, qr|^Schema dump completed| ];
  47
  48   rmtree($dump_path, 1, 1);
  49 }
  50
  51 lives_ok {
  52   warnings_exist { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }
  53     [ qr|^Dumping manual schema|, qr|^Schema dump completed| ];
  54 } 'no death with dump_directory set (overwrite1)' or diag "Dump failed: $@";
  55
  56 DBICTest::Schema::2->_loader_invoked(undef);
  57
  58 lives_ok {
  59   warnings_exist { DBICTest::Schema::2->connect($make_dbictest_db::dsn) }
  60   [
  61     qr/^Dumping manual schema/,
  62     qr|^Deleting .+Schema/2.+ due to 'really_erase_my_files'|,
  63     qr|^Deleting .+Schema/2/Result/Foo.+ due to 'really_erase_my_files'|,
  64     qr|^Deleting .+Schema/2/Result/Bar.+ due to 'really_erase_my_files'|,
  65     qr/^Schema dump completed/
  66   ];
  67 } 'no death with dump_directory set (overwrite2)' or diag "Dump failed: $@";
  68
  69 END { rmtree($dump_path, 1, 1); }