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