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