t/backcompat/0.04006/23dumpmore.t

   1 use strict;
   2 use Test::More;
   3 use lib qw(t/backcompat/0.04006/lib);
   4 use File::Path;
   5 use make_dbictest_db;
   6 use dbixcsl_test_dir qw/$tdir/;
   7
   8 require DBIx::Class::Schema::Loader;
   9
  10 plan skip_all => 'set SCHEMA_LOADER_TESTS_BACKCOMPAT to enable these tests'
  11     unless $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT};
  12
  13 my $DUMP_PATH = "$tdir/dump";
  14
  15 sub do_dump_test {
  16     my %tdata = @_;
  17
  18     my $schema_class = $tdata{classname};
  19
  20     no strict 'refs';
  21     @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
  22
  23     $tdata{options}{use_namespaces} ||= 0;
  24
  25     $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}});
  26
  27     my @warns;
  28     eval {
  29         local $SIG{__WARN__} = sub { push(@warns, @_) };
  30         $schema_class->connect($make_dbictest_db::dsn);
  31     };
  32     my $err = $@;
  33     $schema_class->storage->disconnect if !$err && $schema_class->storage;
  34     undef *{$schema_class};
  35
  36     is($err, $tdata{error});
  37
  38     my $check_warns = $tdata{warnings};
  39     is(@warns, @$check_warns);
  40     for(my $i = 0; $i <= $#$check_warns; $i++) {
  41         like($warns[$i], $check_warns->[$i]);
  42     }
  43
  44     my $file_regexes = $tdata{regexes};
  45     my $file_neg_regexes = $tdata{neg_regexes} || {};
  46     my $schema_regexes = delete $file_regexes->{schema};
  47
  48     my $schema_path = $DUMP_PATH . '/' . $schema_class;
  49     $schema_path =~ s{::}{/}g;
  50     dump_file_like($schema_path . '.pm', @$schema_regexes);
  51     foreach my $src (keys %$file_regexes) {
  52         my $src_file = $schema_path . '/' . $src . '.pm';
  53         dump_file_like($src_file, @{$file_regexes->{$src}});
  54     }
  55     foreach my $src (keys %$file_neg_regexes) {
  56         my $src_file = $schema_path . '/' . $src . '.pm';
  57         dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
  58     }
  59 }
  60
  61 sub dump_file_like {
  62     my $path = shift;
  63     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
  64     my $contents = do { local $/; <$dumpfh>; };
  65     close($dumpfh);
  66     like($contents, $_) for @_;
  67 }
  68
  69 sub dump_file_not_like {
  70     my $path = shift;
  71     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
  72     my $contents = do { local $/; <$dumpfh>; };
  73     close($dumpfh);
  74     unlike($contents, $_) for @_;
  75 }
  76
  77 sub append_to_class {
  78     my ($class, $string) = @_;
  79     $class =~ s{::}{/}g;
  80     $class = $DUMP_PATH . '/' . $class . '.pm';
  81     open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
  82     print $appendfh $string;
  83     close($appendfh);
  84 }
  85
  86 rmtree($DUMP_PATH, 1, 1);
  87
  88 do_dump_test(
  89     classname => 'DBICTest::DumpMore::1',
  90     options => { },
  91     error => '',
  92     warnings => [
  93         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
  94         qr/Schema dump completed/,
  95     ],
  96     regexes => {
  97         schema => [
  98             qr/package DBICTest::DumpMore::1;/,
  99             qr/->load_classes/,
 100         ],
 101         Foo => [
 102             qr/package DBICTest::DumpMore::1::Foo;/,
 103             qr/->set_primary_key/,
 104             qr/1;\n$/,
 105         ],
 106         Bar => [
 107             qr/package DBICTest::DumpMore::1::Bar;/,
 108             qr/->set_primary_key/,
 109             qr/1;\n$/,
 110         ],
 111     },
 112 );
 113
 114 append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 115
 116 do_dump_test(
 117     classname => 'DBICTest::DumpMore::1',
 118     options => { },
 119     error => '',
 120     warnings => [
 121         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 122         qr/Schema dump completed/,
 123     ],
 124     regexes => {
 125         schema => [
 126             qr/package DBICTest::DumpMore::1;/,
 127             qr/->load_classes/,
 128         ],
 129         Foo => [
 130             qr/package DBICTest::DumpMore::1::Foo;/,
 131             qr/->set_primary_key/,
 132             qr/1;\n# XXX This is my custom content XXX/,
 133         ],
 134         Bar => [
 135             qr/package DBICTest::DumpMore::1::Bar;/,
 136             qr/->set_primary_key/,
 137             qr/1;\n$/,
 138         ],
 139     },
 140 );
 141
 142 do_dump_test(
 143     classname => 'DBICTest::DumpMore::1',
 144     options => { really_erase_my_files => 1 },
 145     error => '',
 146     warnings => [
 147         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 148         qr/Deleting existing file /,
 149         qr/Deleting existing file /,
 150         qr/Deleting existing file /,
 151         qr/Schema dump completed/,
 152     ],
 153     regexes => {
 154         schema => [
 155             qr/package DBICTest::DumpMore::1;/,
 156             qr/->load_classes/,
 157         ],
 158         Foo => [
 159             qr/package DBICTest::DumpMore::1::Foo;/,
 160             qr/->set_primary_key/,
 161             qr/1;\n$/,
 162         ],
 163         Bar => [
 164             qr/package DBICTest::DumpMore::1::Bar;/,
 165             qr/->set_primary_key/,
 166             qr/1;\n$/,
 167         ],
 168     },
 169     neg_regexes => {
 170         Foo => [
 171             qr/# XXX This is my custom content XXX/,
 172         ],
 173     },
 174 );
 175
 176 do_dump_test(
 177     classname => 'DBICTest::DumpMore::1',
 178     options => { use_namespaces => 1 },
 179     error => '',
 180     warnings => [
 181         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 182         qr/Schema dump completed/,
 183     ],
 184     regexes => {
 185         schema => [
 186             qr/package DBICTest::DumpMore::1;/,
 187             qr/->load_namespaces/,
 188         ],
 189         'Result/Foo' => [
 190             qr/package DBICTest::DumpMore::1::Result::Foo;/,
 191             qr/->set_primary_key/,
 192             qr/1;\n$/,
 193         ],
 194         'Result/Bar' => [
 195             qr/package DBICTest::DumpMore::1::Result::Bar;/,
 196             qr/->set_primary_key/,
 197             qr/1;\n$/,
 198         ],
 199     },
 200 );
 201
 202 do_dump_test(
 203     classname => 'DBICTest::DumpMore::1',
 204     options => { use_namespaces => 1,
 205                  result_namespace => 'Res',
 206                  resultset_namespace => 'RSet',
 207                  default_resultset_class => 'RSetBase',
 208              },
 209     error => '',
 210     warnings => [
 211         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 212         qr/Schema dump completed/,
 213     ],
 214     regexes => {
 215         schema => [
 216             qr/package DBICTest::DumpMore::1;/,
 217             qr/->load_namespaces/,
 218             qr/result_namespace => "Res"/,
 219             qr/resultset_namespace => "RSet"/,
 220             qr/default_resultset_class => "RSetBase"/,
 221         ],
 222         'Res/Foo' => [
 223             qr/package DBICTest::DumpMore::1::Res::Foo;/,
 224             qr/->set_primary_key/,
 225             qr/1;\n$/,
 226         ],
 227         'Res/Bar' => [
 228             qr/package DBICTest::DumpMore::1::Res::Bar;/,
 229             qr/->set_primary_key/,
 230             qr/1;\n$/,
 231         ],
 232     },
 233 );
 234
 235 do_dump_test(
 236     classname => 'DBICTest::DumpMore::1',
 237     options => { use_namespaces => 1,
 238                  result_namespace => '+DBICTest::DumpMore::1::Res',
 239                  resultset_namespace => 'RSet',
 240                  default_resultset_class => 'RSetBase',
 241                  result_base_class => 'My::ResultBaseClass',
 242                  schema_base_class => 'My::SchemaBaseClass',
 243              },
 244     error => '',
 245     warnings => [
 246         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 247         qr/Schema dump completed/,
 248     ],
 249     regexes => {
 250         schema => [
 251             qr/package DBICTest::DumpMore::1;/,
 252             qr/->load_namespaces/,
 253             qr/result_namespace => "\+DBICTest::DumpMore::1::Res"/,
 254             qr/resultset_namespace => "RSet"/,
 255             qr/default_resultset_class => "RSetBase"/,
 256             qr/use base 'My::SchemaBaseClass'/,
 257         ],
 258         'Res/Foo' => [
 259             qr/package DBICTest::DumpMore::1::Res::Foo;/,
 260             qr/use base 'My::ResultBaseClass'/,
 261             qr/->set_primary_key/,
 262             qr/1;\n$/,
 263         ],
 264         'Res/Bar' => [
 265             qr/package DBICTest::DumpMore::1::Res::Bar;/,
 266             qr/use base 'My::ResultBaseClass'/,
 267             qr/->set_primary_key/,
 268             qr/1;\n$/,
 269         ],
 270     },
 271 );
 272
 273 done_testing;
 274
 275 END { rmtree($DUMP_PATH, 1, 1) if $ENV{SCHEMA_LOADER_TESTS_BACKCOMPAT}; }