t/backcompat/0.04006/23dumpmore.t

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