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 => 91);
  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     my $current_md5sums = {}; # keep track of the md5sums we make so we can return them.
  57     my $file_md5sum_equals = $tdata{md5sum_equals} || {};
  58     foreach my $src (keys %$file_md5sum_equals) {
  59         my $src_file;
  60         if ($src eq 'schema' ) {
  61             $src_file = $schema_path . '.pm';
  62         } else {
  63             $src_file = $schema_path . '/' . $src . '.pm';
  64         }
  65         my $current_md5sum = get_md5sum_from_dump_file($src_file);
  66         is( $current_md5sum, $file_md5sum_equals->{$src}, "found the same md5sum ($current_md5sum) for file $src_file" );
  67         $current_md5sums->{$src} = $current_md5sum;
  68     }
  69
  70     my $file_md5sum_ne = $tdata{md5sum_ne} || {};
  71     foreach my $src (keys %$file_md5sum_ne) {
  72         my $src_file;
  73         if ($src eq 'schema' ) {
  74             $src_file = $schema_path . '.pm';
  75         } else {
  76             $src_file = $schema_path . '/' . $src . '.pm';
  77         }
  78         my $current_md5sum = get_md5sum_from_dump_file($src_file);
  79         isnt( $current_md5sum, $file_md5sum_equals->{$src}, "found different md5sum ($current_md5sum) for file $src_file" );
  80         $current_md5sums->{$src} = $current_md5sum;
  81     }
  82     return { md5sums => $current_md5sums };
  83 }
  84
  85 sub dump_file_like {
  86     my $path = shift;
  87     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
  88     my $contents = do { local $/; <$dumpfh>; };
  89     close($dumpfh);
  90     like($contents, $_) for @_;
  91 }
  92
  93 sub dump_file_not_like {
  94     my $path = shift;
  95     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
  96     my $contents = do { local $/; <$dumpfh>; };
  97     close($dumpfh);
  98     unlike($contents, $_) for @_;
  99 }
 100
 101 sub append_to_class {
 102     my ($class, $string) = @_;
 103     $class =~ s{::}{/}g;
 104     $class = $DUMP_PATH . '/' . $class . '.pm';
 105     open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
 106     print $appendfh $string;
 107     close($appendfh);
 108 }
 109
 110 sub get_md5sum_from_dump_file {
 111     my $path = shift;
 112     open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
 113     my $contents = do { local $/; <$dumpfh>; };
 114     close($dumpfh);
 115     if ( $contents =~ /md5sum:([^\s]+)/ ) {
 116         return $1;
 117     }
 118     return;
 119 }
 120
 121 rmtree($DUMP_PATH, 1, 1);
 122
 123 my $dumped = do_dump_test(
 124     classname => 'DBICTest::DumpMore::1',
 125     options => { },
 126     error => '',
 127     warnings => [
 128         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 129         qr/Schema dump completed/,
 130     ],
 131     regexes => {
 132         schema => [
 133             qr/package DBICTest::DumpMore::1;/,
 134             qr/->load_classes/,
 135         ],
 136         Foo => [
 137             qr/package DBICTest::DumpMore::1::Foo;/,
 138             qr/->set_primary_key/,
 139             qr/1;\n$/,
 140         ],
 141         Bar => [
 142             qr/package DBICTest::DumpMore::1::Bar;/,
 143             qr/->set_primary_key/,
 144             qr/1;\n$/,
 145         ],
 146     },
 147     md5sum_ne => {
 148                   schema => '',
 149                   Foo    => '',
 150                   Bar    => '',
 151               },
 152 );
 153
 154 append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
 155
 156 $dumped = do_dump_test(
 157     classname => 'DBICTest::DumpMore::1',
 158     options => { },
 159     error => '',
 160     warnings => [
 161         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 162         qr/Schema dump completed/,
 163     ],
 164     regexes => {
 165         schema => [
 166             qr/package DBICTest::DumpMore::1;/,
 167             qr/->load_classes/,
 168         ],
 169         Foo => [
 170             qr/package DBICTest::DumpMore::1::Foo;/,
 171             qr/->set_primary_key/,
 172             qr/1;\n# XXX This is my custom content XXX/,
 173         ],
 174         Bar => [
 175             qr/package DBICTest::DumpMore::1::Bar;/,
 176             qr/->set_primary_key/,
 177             qr/1;\n$/,
 178         ],
 179     },
 180     md5sum_equals => $dumped->{'md5sums'},
 181 );
 182
 183 $dumped = do_dump_test(
 184     classname => 'DBICTest::DumpMore::1',
 185     options => { really_erase_my_files => 1 },
 186     error => '',
 187     warnings => [
 188         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 189         qr/Deleting existing file /,
 190         qr/Deleting existing file /,
 191         qr/Deleting existing file /,
 192         qr/Schema dump completed/,
 193     ],
 194     regexes => {
 195         schema => [
 196             qr/package DBICTest::DumpMore::1;/,
 197             qr/->load_classes/,
 198         ],
 199         Foo => [
 200             qr/package DBICTest::DumpMore::1::Foo;/,
 201             qr/->set_primary_key/,
 202             qr/1;\n$/,
 203         ],
 204         Bar => [
 205             qr/package DBICTest::DumpMore::1::Bar;/,
 206             qr/->set_primary_key/,
 207             qr/1;\n$/,
 208         ],
 209     },
 210     neg_regexes => {
 211         Foo => [
 212             qr/# XXX This is my custom content XXX/,
 213         ],
 214     },
 215     md5sum_ne => $dumped->{'md5sums'},
 216 );
 217
 218 do_dump_test(
 219     classname => 'DBICTest::DumpMore::1',
 220     options => { use_namespaces => 1 },
 221     error => '',
 222     warnings => [
 223         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 224         qr/Schema dump completed/,
 225     ],
 226     regexes => {
 227         schema => [
 228             qr/package DBICTest::DumpMore::1;/,
 229             qr/->load_namespaces/,
 230         ],
 231         'Result/Foo' => [
 232             qr/package DBICTest::DumpMore::1::Result::Foo;/,
 233             qr/->set_primary_key/,
 234             qr/1;\n$/,
 235         ],
 236         'Result/Bar' => [
 237             qr/package DBICTest::DumpMore::1::Result::Bar;/,
 238             qr/->set_primary_key/,
 239             qr/1;\n$/,
 240         ],
 241     },
 242 );
 243
 244 do_dump_test(
 245     classname => 'DBICTest::DumpMore::1',
 246     options => { use_namespaces => 1,
 247                  result_namespace => 'Res',
 248                  resultset_namespace => 'RSet',
 249                  default_resultset_class => 'RSetBase',
 250              },
 251     error => '',
 252     warnings => [
 253         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 254         qr/Schema dump completed/,
 255     ],
 256     regexes => {
 257         schema => [
 258             qr/package DBICTest::DumpMore::1;/,
 259             qr/->load_namespaces/,
 260             qr/result_namespace => 'Res'/,
 261             qr/resultset_namespace => 'RSet'/,
 262             qr/default_resultset_class => 'RSetBase'/,
 263         ],
 264         'Res/Foo' => [
 265             qr/package DBICTest::DumpMore::1::Res::Foo;/,
 266             qr/->set_primary_key/,
 267             qr/1;\n$/,
 268         ],
 269         'Res/Bar' => [
 270             qr/package DBICTest::DumpMore::1::Res::Bar;/,
 271             qr/->set_primary_key/,
 272             qr/1;\n$/,
 273         ],
 274     },
 275 );
 276
 277 do_dump_test(
 278     classname => 'DBICTest::DumpMore::1',
 279     options => { use_namespaces => 1,
 280                  result_namespace => '+DBICTest::DumpMore::1::Res',
 281                  resultset_namespace => 'RSet',
 282                  default_resultset_class => 'RSetBase',
 283              },
 284     error => '',
 285     warnings => [
 286         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
 287         qr/Schema dump completed/,
 288     ],
 289     regexes => {
 290         schema => [
 291             qr/package DBICTest::DumpMore::1;/,
 292             qr/->load_namespaces/,
 293             qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
 294             qr/resultset_namespace => 'RSet'/,
 295             qr/default_resultset_class => 'RSetBase'/,
 296         ],
 297         'Res/Foo' => [
 298             qr/package DBICTest::DumpMore::1::Res::Foo;/,
 299             qr/->set_primary_key/,
 300             qr/1;\n$/,
 301         ],
 302         'Res/Bar' => [
 303             qr/package DBICTest::DumpMore::1::Res::Bar;/,
 304             qr/->set_primary_key/,
 305             qr/1;\n$/,
 306         ],
 307     },
 308 );
 309
 310 END { rmtree($DUMP_PATH, 1, 1); }