t/23dumpmore.t

   1 use strict;
   2 use Test::More;
   3 use lib qw(t/lib);
   4 use File::Path;
   5 use make_dbictest_db;
   6 require DBIx::Class::Schema::Loader;
   7
   8 $^O eq 'MSWin32'
   9     ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths")
  10     : plan(tests => 40);
  11
  12 my $DUMP_PATH = './t/_dump';
  13
  14 sub do_dump_test {
  15     my %tdata = @_;
  16
  17     my $schema_class = $tdata{classname};
  18
  19     no strict 'refs';
  20     @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
  21     $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}});
  22
  23     my @warns;
  24     eval {
  25         local $SIG{__WARN__} = sub { push(@warns, @_) };
  26         $schema_class->connect($make_dbictest_db::dsn);
  27     };
  28     my $err = $@;
  29     $schema_class->storage->disconnect if !$err && $schema_class->storage;
  30     undef *{$schema_class};
  31
  32     is($err, $tdata{error});
  33
  34     my $check_warns = $tdata{warnings};
  35     is(@warns, @$check_warns);
  36     for(my $i = 0; $i <= $#$check_warns; $i++) {
  37         like($warns[$i], $check_warns->[$i]);
  38     }
  39
  40     my $file_regexes = $tdata{regexes};
  41     my $file_neg_regexes = $tdata{neg_regexes} || {};
  42     my $schema_regexes = delete $file_regexes->{schema};
  43
  44     my $schema_path = $DUMP_PATH . '/' . $schema_class;
  45     $schema_path =~ s{::}{/}g;
  46     dump_file_like($schema_path . '.pm', @$schema_regexes);
  47     foreach my $src (keys %$file_regexes) {
  48         my $src_file = $schema_path . '/' . $src . '.pm';
  49         dump_file_like($src_file, @{$file_regexes->{$src}});
  50     }
  51     foreach my $src (keys %$file_neg_regexes) {
  52         my $src_file = $schema_path . '/' . $src . '.pm';
  53         dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
  54     }
  55 }
  56
  57 sub dump_file_like {
  58     my $path = shift;
  59     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
  60     my $contents = do { local $/; <$dumpfh>; };
  61     close($dumpfh);
  62     like($contents, $_) for @_;
  63 }
  64
  65 sub dump_file_not_like {
  66     my $path = shift;
  67     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
  68     my $contents = do { local $/; <$dumpfh>; };
  69     close($dumpfh);
  70     unlike($contents, $_) for @_;
  71 }
  72
  73 sub append_to_class {
  74     my ($class, $string) = @_;
  75     $class =~ s{::}{/}g;
  76     $class = $DUMP_PATH . '/' . $class . '.pm';
  77     open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
  78     print $appendfh $string;
  79     close($appendfh);
  80 }
  81
  82 rmtree($DUMP_PATH, 1, 1);
  83
  84 do_dump_test(
  85     classname => 'DBICTest::DumpMore::1',
  86     options => { },
  87     error => '',
  88     warnings => [
  89         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
  90         qr/Schema dump completed/,
  91     ],
  92     regexes => {
  93         schema => [
  94             qr/package DBICTest::DumpMore::1;/,
  95             qr/->load_classes/,
  96         ],
  97         Foo => [
  98             qr/package DBICTest::DumpMore::1::Foo;/,
  99             qr/->set_primary_key/,
 100             qr/1;\n$/,
 101         ],
 102         Bar => [
 103             qr/package DBICTest::DumpMore::1::Bar;/,
 104             qr/->set_primary_key/,
 105             qr/1;\n$/,
 106         ],
 107     },
 108 );
 109
 110 append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 111
 112 do_dump_test(
 113     classname => 'DBICTest::DumpMore::1',
 114     options => { },
 115     error => '',
 116     warnings => [
 117         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 118         qr/Schema dump completed/,
 119     ],
 120     regexes => {
 121         schema => [
 122             qr/package DBICTest::DumpMore::1;/,
 123             qr/->load_classes/,
 124         ],
 125         Foo => [
 126             qr/package DBICTest::DumpMore::1::Foo;/,
 127             qr/->set_primary_key/,
 128             qr/1;\n# XXX This is my custom content XXX/,
 129         ],
 130         Bar => [
 131             qr/package DBICTest::DumpMore::1::Bar;/,
 132             qr/->set_primary_key/,
 133             qr/1;\n$/,
 134         ],
 135     },
 136 );
 137
 138 do_dump_test(
 139     classname => 'DBICTest::DumpMore::1',
 140     options => { really_erase_my_files => 1 },
 141     error => '',
 142     warnings => [
 143         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 144         qr/Deleting existing file /,
 145         qr/Deleting existing file /,
 146         qr/Deleting existing file /,
 147         qr/Schema dump completed/,
 148     ],
 149     regexes => {
 150         schema => [
 151             qr/package DBICTest::DumpMore::1;/,
 152             qr/->load_classes/,
 153         ],
 154         Foo => [
 155             qr/package DBICTest::DumpMore::1::Foo;/,
 156             qr/->set_primary_key/,
 157             qr/1;\n$/,
 158         ],
 159         Bar => [
 160             qr/package DBICTest::DumpMore::1::Bar;/,
 161             qr/->set_primary_key/,
 162             qr/1;\n$/,
 163         ],
 164     },
 165     neg_regexes => {
 166         Foo => [
 167             qr/# XXX This is my custom content XXX/,
 168         ],
 169     },
 170 );
 171
 172 END { rmtree($DUMP_PATH, 1, 1); }