[dbsrgits/DBIx-Class-Schema-Loader.git] / t / 23dumpmore.t

use strict;
use Test::More;
use lib qw(t/lib);
use File::Path;
use make_dbictest_db;
require DBIx::Class::Schema::Loader;

$^O eq 'MSWin32'
    ? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths")
    : plan(tests => 91);

my $DUMP_PATH = './t/_dump';

sub do_dump_test {
    my %tdata = @_;

    my $schema_class = $tdata{classname};

    no strict 'refs';
    @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
    $schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}});

    my @warns;
    eval {
        local $SIG{__WARN__} = sub { push(@warns, @_) };
        $schema_class->connect($make_dbictest_db::dsn);
    };
    my $err = $@;
    $schema_class->storage->disconnect if !$err && $schema_class->storage;
    undef *{$schema_class};

    is($err, $tdata{error});

    my $check_warns = $tdata{warnings};
    is(@warns, @$check_warns);
    for(my $i = 0; $i <= $#$check_warns; $i++) {
        like($warns[$i], $check_warns->[$i]);
    }

    my $file_regexes = $tdata{regexes};
    my $file_neg_regexes = $tdata{neg_regexes} || {};
    my $schema_regexes = delete $file_regexes->{schema};
    
    my $schema_path = $DUMP_PATH . '/' . $schema_class;
    $schema_path =~ s{::}{/}g;
    dump_file_like($schema_path . '.pm', @$schema_regexes);
    foreach my $src (keys %$file_regexes) {
        my $src_file = $schema_path . '/' . $src . '.pm';
        dump_file_like($src_file, @{$file_regexes->{$src}});
    }
    foreach my $src (keys %$file_neg_regexes) {
        my $src_file = $schema_path . '/' . $src . '.pm';
        dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
    }

    my $current_md5sums = {}; # keep track of the md5sums we make so we can return them.
    my $file_md5sum_equals = $tdata{md5sum_equals} || {};
    foreach my $src (keys %$file_md5sum_equals) {
        my $src_file;
        if ($src eq 'schema' ) {
            $src_file = $schema_path . '.pm';
        } else {
            $src_file = $schema_path . '/' . $src . '.pm';
        }
        my $current_md5sum = get_md5sum_from_dump_file($src_file);
        is( $current_md5sum, $file_md5sum_equals->{$src}, "found the same md5sum ($current_md5sum) for file $src_file" );
        $current_md5sums->{$src} = $current_md5sum;
    }

    my $file_md5sum_ne = $tdata{md5sum_ne} || {};
    foreach my $src (keys %$file_md5sum_ne) {
        my $src_file;
        if ($src eq 'schema' ) {
            $src_file = $schema_path . '.pm';
        } else {
            $src_file = $schema_path . '/' . $src . '.pm';
        }
        my $current_md5sum = get_md5sum_from_dump_file($src_file);
        isnt( $current_md5sum, $file_md5sum_equals->{$src}, "found different md5sum ($current_md5sum) for file $src_file" );
        $current_md5sums->{$src} = $current_md5sum;
    }
    return { md5sums => $current_md5sums };
}

sub dump_file_like {
    my $path = shift;
    open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
    my $contents = do { local $/; <$dumpfh>; };
    close($dumpfh);
    like($contents, $_) for @_;
}

sub dump_file_not_like {
    my $path = shift;
    open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
    my $contents = do { local $/; <$dumpfh>; };
    close($dumpfh);
    unlike($contents, $_) for @_;
}

sub append_to_class {
    my ($class, $string) = @_;
    $class =~ s{::}{/}g;
    $class = $DUMP_PATH . '/' . $class . '.pm';
    open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
    print $appendfh $string;
    close($appendfh);
}

sub get_md5sum_from_dump_file {
    my $path = shift;
    open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
    my $contents = do { local $/; <$dumpfh>; };
    close($dumpfh);
    if ( $contents =~ /md5sum:([^\s]+)/ ) {
        return $1;
    }
    return;
}

rmtree($DUMP_PATH, 1, 1);

my $dumped = do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { },
    error => '',
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Schema dump completed/,
    ],
    regexes => {
        schema => [
            qr/package DBICTest::DumpMore::1;/,
            qr/->load_classes/,
        ],
        Foo => [
            qr/package DBICTest::DumpMore::1::Foo;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
        Bar => [
            qr/package DBICTest::DumpMore::1::Bar;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
    },
    md5sum_ne => {
                  schema => '',
                  Foo    => '',
                  Bar    => '',
              },
);

append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});

$dumped = do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { },
    error => '',
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Schema dump completed/,
    ],
    regexes => {
        schema => [
            qr/package DBICTest::DumpMore::1;/,
            qr/->load_classes/,
        ],
        Foo => [
            qr/package DBICTest::DumpMore::1::Foo;/,
            qr/->set_primary_key/,
            qr/1;\n# XXX This is my custom content XXX/,
        ],
        Bar => [
            qr/package DBICTest::DumpMore::1::Bar;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
    },
    md5sum_equals => $dumped->{'md5sums'},
);

$dumped = do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { really_erase_my_files => 1 },
    error => '',
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Deleting existing file /,
        qr/Deleting existing file /,
        qr/Deleting existing file /,
        qr/Schema dump completed/,
    ],
    regexes => {
        schema => [
            qr/package DBICTest::DumpMore::1;/,
            qr/->load_classes/,
        ],
        Foo => [
            qr/package DBICTest::DumpMore::1::Foo;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
        Bar => [
            qr/package DBICTest::DumpMore::1::Bar;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
    },
    neg_regexes => {
        Foo => [
            qr/# XXX This is my custom content XXX/,
        ],
    },
    md5sum_ne => $dumped->{'md5sums'},
);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { use_namespaces => 1 },
    error => '',
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Schema dump completed/,
    ],
    regexes => {
        schema => [
            qr/package DBICTest::DumpMore::1;/,
            qr/->load_namespaces/,
        ],
        'Result/Foo' => [
            qr/package DBICTest::DumpMore::1::Result::Foo;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
        'Result/Bar' => [
            qr/package DBICTest::DumpMore::1::Result::Bar;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
    },
);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { use_namespaces => 1,
                 result_namespace => 'Res',
                 resultset_namespace => 'RSet',
                 default_resultset_class => 'RSetBase',
             },
    error => '',
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Schema dump completed/,
    ],
    regexes => {
        schema => [
            qr/package DBICTest::DumpMore::1;/,
            qr/->load_namespaces/,
            qr/result_namespace => 'Res'/,
            qr/resultset_namespace => 'RSet'/,
            qr/default_resultset_class => 'RSetBase'/,
        ],
        'Res/Foo' => [
            qr/package DBICTest::DumpMore::1::Res::Foo;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
        'Res/Bar' => [
            qr/package DBICTest::DumpMore::1::Res::Bar;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
    },
);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { use_namespaces => 1,
                 result_namespace => '+DBICTest::DumpMore::1::Res',
                 resultset_namespace => 'RSet',
                 default_resultset_class => 'RSetBase',
             },
    error => '',
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Schema dump completed/,
    ],
    regexes => {
        schema => [
            qr/package DBICTest::DumpMore::1;/,
            qr/->load_namespaces/,
            qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
            qr/resultset_namespace => 'RSet'/,
            qr/default_resultset_class => 'RSetBase'/,
        ],
        'Res/Foo' => [
            qr/package DBICTest::DumpMore::1::Res::Foo;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
        'Res/Bar' => [
            qr/package DBICTest::DumpMore::1::Res::Bar;/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
    },
);

END { rmtree($DUMP_PATH, 1, 1); }
Commit	Line	Data
605fcea8	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
12c918bd	8	$^O eq 'MSWin32'
12c918bd	9	? plan(skip_all => "ActiveState perl produces additional warnings, and this test uses unix paths")
fb01c180	10	: plan(tests => 91);
605fcea8	11
a4187fdf	12	my $DUMP_PATH = './t/_dump';
605fcea8	13
605fcea8	14	sub do_dump_test {
a4187fdf	15	my %tdata = @_;
605fcea8	16
a4187fdf	17	my $schema_class = $tdata{classname};
605fcea8	18
	19	no strict 'refs';
	20	@{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
a4187fdf	21	$schema_class->loader_options(dump_directory => $DUMP_PATH, %{$tdata{options}});
605fcea8	22
a4187fdf	23	my @warns;
605fcea8	24	eval {
a4187fdf	25	local $SIG{__WARN__} = sub { push(@warns, @_) };
605fcea8	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};
a4187fdf	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	}
fb01c180	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 };
605fcea8	83	}
605fcea8	84
a4187fdf	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	}
605fcea8	92
a4187fdf	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 @_;
605fcea8	99	}
605fcea8	100
a4187fdf	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
fb01c180	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
a4187fdf	121	rmtree($DUMP_PATH, 1, 1);
a4187fdf	122
fb01c180	123	my $dumped = do_dump_test(
a4187fdf	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	},
fb01c180	147	md5sum_ne => {
	148	schema => '',
	149	Foo => '',
	150	Bar => '',
	151	},
a4187fdf	152	);
	153
	154	append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
	155
fb01c180	156	$dumped = do_dump_test(
a4187fdf	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	},
fb01c180	180	md5sum_equals => $dumped->{'md5sums'},
a4187fdf	181	);
605fcea8	182
fb01c180	183	$dumped = do_dump_test(
a4187fdf	184	classname => 'DBICTest::DumpMore::1',
28b4691d	185	options => { really_erase_my_files => 1 },
a4187fdf	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	},
fb01c180	215	md5sum_ne => $dumped->{'md5sums'},
a4187fdf	216	);
605fcea8	217
f44ecc2f	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
a4187fdf	310	END { rmtree($DUMP_PATH, 1, 1); }