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

use strict;
use Test::More;
use File::Path;
use IPC::Open3;
use Data::Dumper::Concise;
use DBIx::Class::Schema::Loader ();
use File::Temp 'tempfile';
use lib qw(t/lib);

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

my $TEST_DB_CLASS = 'make_dbictest_db';

sub dump_directly {
    my %tdata = @_;

    my $schema_class = $tdata{classname};

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

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

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

    return @warns;
}

sub dump_dbicdump {
    my %tdata = @_;

    # use $^X so we execute ./script/dbicdump with the same perl binary that the tests were executed with
    my @cmd = ($^X, qw(./script/dbicdump));

    while (my ($opt, $val) = each(%{ $tdata{options} })) {
        $val = Dumper($val) if ref $val;
        push @cmd, '-o', "$opt=$val";
    }

    push @cmd, $tdata{classname}, get_dsn(\%tdata);

    # make sure our current @INC gets used by dbicdump
    use Config;
    local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, ($ENV{PERL5LIB} || '');

    my ($in, $out, $err);
    my $pid = open3($in, $out, $err, @cmd);

    my @out = <$out>;
    waitpid($pid, 0);

    my ($error, @warns);

    if ($? >> 8 != 0) {
        $error = $out[0];
        check_error($error, $tdata{error});
    }
    else {
        @warns = @out;
    }

    return @warns;
}

sub get_dsn {
    my $opts = shift;

    my $test_db_class = $opts->{test_db_class} || $TEST_DB_CLASS;

    eval "require $test_db_class;";
    die $@ if $@;

    my $dsn = do {
        no strict 'refs';
        ${$test_db_class . '::dsn'};
    };

    return $dsn;
}

sub check_error {
    my ($got, $expected) = @_;

    return unless $got && $expected;

    if (ref $expected eq 'Regexp') {
        like $got, $expected, 'error matches expected pattern';
        return;
    }

    is $got, $expected, 'error matches';
}

sub do_dump_test {
    my %tdata = @_;
    
    $tdata{options}{dump_directory} = $DUMP_PATH;
    $tdata{options}{use_namespaces} ||= 0;

    for my $dumper (\&dump_directly, \&dump_dbicdump) {
        test_dumps(\%tdata, $dumper->(%tdata));
    }
}

sub test_dumps {
    my ($tdata, @warns) = @_;

    my %tdata = %{$tdata};

    my $schema_class = $tdata{classname};
    my $check_warns = $tdata{warnings};
    is(@warns, @$check_warns, "$schema_class warning count");

    for(my $i = 0; $i <= $#$check_warns; $i++) {
        like($warns[$i], $check_warns->[$i], "$schema_class warning $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) if $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}});
    }
}

sub dump_file_like {
    my $path = shift;
    open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
    my $contents = do { local $/; <$dumpfh>; };
    close($dumpfh);
    my $num = 1;
    like($contents, $_, "like $path " . $num++) 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);
    my $num = 1;
    unlike($contents, $_, "unlike $path ". $num++) 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);
}

rmtree($DUMP_PATH, 1, 1);

# test loading external content
do_dump_test(
    classname => 'DBICTest::Schema::13',
    warnings => [
        qr/Dumping manual schema for DBICTest::Schema::13 to directory /,
        qr/Schema dump completed/,
    ],
    regexes => {
        Foo => [
qr/package DBICTest::Schema::13::Foo;\nour \$skip_me = "bad mojo";\n1;/
        ],
    },
);

# test skipping external content
do_dump_test(
    classname => 'DBICTest::Schema::14',
    options => { skip_load_external => 1 },
    warnings => [
        qr/Dumping manual schema for DBICTest::Schema::14 to directory /,
        qr/Schema dump completed/,
    ],
    neg_regexes => {
        Foo => [
qr/package DBICTest::Schema::14::Foo;\nour \$skip_me = "bad mojo";\n1;/
        ],
    },
);

rmtree($DUMP_PATH, 1, 1);

# test config_file

my ($fh, $config_file) = tempfile;

print $fh <<'EOF';
{ skip_relationships => 1 }
EOF
close $fh;

do_dump_test(
    classname => 'DBICTest::Schema::14',
    options => { config_file => $config_file },
    warnings => [
        qr/Dumping manual schema for DBICTest::Schema::14 to directory /,
        qr/Schema dump completed/,
    ],
    neg_regexes => {
        Foo => [
            qr/has_many/,
        ],
    },
);

unlink $config_file;

rmtree($DUMP_PATH, 1, 1);

do_dump_test(
    classname => 'DBICTest::Schema::14',
    test_db_class => 'make_dbictest_db_clashing_monikers',
    error => qr/tables 'bar', 'bars' reduced to the same source moniker 'Bar'/,
);

rmtree($DUMP_PATH, 1, 1);

# test out the POD

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => {
        custom_column_info => sub {
            my ($table, $col, $info) = @_;
            return +{ extra => { is_footext => 1 } } if $col eq 'footext';
        }
    },
    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/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
qr/=head1 ACCESSORS\n\n/,
qr/=head2 fooid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 1\n\n/,
qr/=head2 footext\n\n  data_type: 'text'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n\n/,
qr/->set_primary_key/,
qr/=head1 RELATIONS\n\n/,
qr/=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
qr/1;\n$/,
        ],
        Bar => [
qr/package DBICTest::DumpMore::1::Bar;/,
qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
qr/=head1 ACCESSORS\n\n/,
qr/=head2 barid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 1\n\n/,
qr/=head2 fooref\n\n  data_type: 'integer'\n  is_foreign_key: 1\n  is_nullable: 1\n\n/,
qr/->set_primary_key/,
qr/=head1 RELATIONS\n\n/,
qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
qr/1;\n$/,
        ],
    },
);

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

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    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$/,
        ],
    },
);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { really_erase_my_files => 1 },
    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/,
        ],
    },
);

rmtree($DUMP_PATH, 1, 1);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { use_namespaces => 1, generate_pod => 0 },
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Schema dump completed/,
    ],
    neg_regexes => {
        'Result/Foo' => [
            qr/^=/m,
        ],
    },
);

rmtree($DUMP_PATH, 1, 1);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { db_schema => 'foo_schema', qualify_objects => 1, use_namespaces => 1 },
    warnings => [
        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
        qr/Schema dump completed/,
    ],
    regexes => {
        'Result/Foo' => [
            qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
            # the has_many relname should not have the schema in it!
            qr/^__PACKAGE__->has_many\(\n  "bars"/m,
        ],
    },
);

rmtree($DUMP_PATH, 1, 1);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { use_namespaces => 1 },
    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$/,
        ],
    },
);

rmtree($DUMP_PATH, 1, 1);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { use_namespaces => 1,
                 result_namespace => 'Res',
                 resultset_namespace => 'RSet',
                 default_resultset_class => 'RSetBase',
             },
    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$/,
        ],
    },
);

rmtree($DUMP_PATH, 1, 1);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options => { use_namespaces => 1,
                 result_namespace => '+DBICTest::DumpMore::1::Res',
                 resultset_namespace => 'RSet',
                 default_resultset_class => 'RSetBase',
                 result_base_class => 'My::ResultBaseClass',
                 schema_base_class => 'My::SchemaBaseClass',
             },
    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'/,
            qr/use base 'My::SchemaBaseClass'/,
        ],
        'Res/Foo' => [
            qr/package DBICTest::DumpMore::1::Res::Foo;/,
            qr/use base 'My::ResultBaseClass'/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
        'Res/Bar' => [
            qr/package DBICTest::DumpMore::1::Res::Bar;/,
            qr/use base 'My::ResultBaseClass'/,
            qr/->set_primary_key/,
            qr/1;\n$/,
        ],
    },
);

rmtree($DUMP_PATH, 1, 1);

do_dump_test(
    classname => 'DBICTest::DumpMore::1',
    options   => {
        use_namespaces    => 1,
        result_base_class => 'My::MissingResultBaseClass',
    },
    error => qr/My::MissingResultBaseClass.*is not installed/,
);

done_testing;

END { rmtree($DUMP_PATH, 1, 1) unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} }
# vim:et sts=4 sw=4 tw=0:
Commit	Line	Data
605fcea8	1	use strict;
605fcea8	2	use Test::More;
605fcea8	3	use File::Path;
ff746964	4	use IPC::Open3;
f170d55b	5	use Data::Dumper::Concise;
73099af4	6	use DBIx::Class::Schema::Loader ();
	7	use File::Temp 'tempfile';
	8	use lib qw(t/lib);
605fcea8	9
a4187fdf	10	my $DUMP_PATH = './t/_dump';
605fcea8	11
f812ef60	12	my $TEST_DB_CLASS = 'make_dbictest_db';
f812ef60	13
ff746964	14	sub dump_directly {
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');
ff746964	21	$schema_class->loader_options(%{$tdata{options}});
605fcea8	22
a4187fdf	23	my @warns;
605fcea8	24	eval {
a4187fdf	25	local $SIG{__WARN__} = sub { push(@warns, @_) };
f812ef60	26	$schema_class->connect(get_dsn(\%tdata));
605fcea8	27	};
	28	my $err = $@;
	29	$schema_class->storage->disconnect if !$err && $schema_class->storage;
	30	undef *{$schema_class};
a4187fdf	31
8048320c	32	check_error($err, $tdata{error});
a4187fdf	33
ff746964	34	return @warns;
	35	}
	36
	37	sub dump_dbicdump {
	38	my %tdata = @_;
	39
17ca645f	40	# use $^X so we execute ./script/dbicdump with the same perl binary that the tests were executed with
17ca645f	41	my @cmd = ($^X, qw(./script/dbicdump));
ff746964	42
ff746964	43	while (my ($opt, $val) = each(%{ $tdata{options} })) {
f170d55b	44	$val = Dumper($val) if ref $val;
ff746964	45	push @cmd, '-o', "$opt=$val";
	46	}
	47
f812ef60	48	push @cmd, $tdata{classname}, get_dsn(\%tdata);
ff746964	49
17ca645f	50	# make sure our current @INC gets used by dbicdump
f1059ad4	51	use Config;
8048320c	52	local $ENV{PERL5LIB} = join $Config{path_sep}, @INC, ($ENV{PERL5LIB} \|\| '');
17ca645f	53
ff746964	54	my ($in, $out, $err);
	55	my $pid = open3($in, $out, $err, @cmd);
	56
8048320c	57	my @out = <$out>;
ff746964	58	waitpid($pid, 0);
ff746964	59
8048320c	60	my ($error, @warns);
	61
	62	if ($? >> 8 != 0) {
	63	$error = $out[0];
	64	check_error($error, $tdata{error});
	65	}
	66	else {
	67	@warns = @out;
	68	}
	69
ff746964	70	return @warns;
	71	}
	72
f812ef60	73	sub get_dsn {
	74	my $opts = shift;
	75
	76	my $test_db_class = $opts->{test_db_class} \|\| $TEST_DB_CLASS;
	77
	78	eval "require $test_db_class;";
	79	die $@ if $@;
	80
	81	my $dsn = do {
	82	no strict 'refs';
	83	${$test_db_class . '::dsn'};
	84	};
	85
	86	return $dsn;
	87	}
	88
8048320c	89	sub check_error {
	90	my ($got, $expected) = @_;
	91
	92	return unless $got && $expected;
	93
	94	if (ref $expected eq 'Regexp') {
	95	like $got, $expected, 'error matches expected pattern';
	96	return;
	97	}
	98
	99	is $got, $expected, 'error matches';
	100	}
	101
ff746964	102	sub do_dump_test {
	103	my %tdata = @_;
	104
	105	$tdata{options}{dump_directory} = $DUMP_PATH;
f22644d7	106	$tdata{options}{use_namespaces} \|\|= 0;
ff746964	107
	108	for my $dumper (\&dump_directly, \&dump_dbicdump) {
	109	test_dumps(\%tdata, $dumper->(%tdata));
	110	}
	111	}
	112
	113	sub test_dumps {
	114	my ($tdata, @warns) = @_;
	115
	116	my %tdata = %{$tdata};
	117
	118	my $schema_class = $tdata{classname};
a4187fdf	119	my $check_warns = $tdata{warnings};
ff746964	120	is(@warns, @$check_warns, "$schema_class warning count");
8048320c	121
a4187fdf	122	for(my $i = 0; $i <= $#$check_warns; $i++) {
ff746964	123	like($warns[$i], $check_warns->[$i], "$schema_class warning $i");
a4187fdf	124	}
	125
	126	my $file_regexes = $tdata{regexes};
	127	my $file_neg_regexes = $tdata{neg_regexes} \|\| {};
	128	my $schema_regexes = delete $file_regexes->{schema};
	129
	130	my $schema_path = $DUMP_PATH . '/' . $schema_class;
	131	$schema_path =~ s{::}{/}g;
f812ef60	132
	133	dump_file_like($schema_path . '.pm', @$schema_regexes) if $schema_regexes;
	134
a4187fdf	135	foreach my $src (keys %$file_regexes) {
	136	my $src_file = $schema_path . '/' . $src . '.pm';
	137	dump_file_like($src_file, @{$file_regexes->{$src}});
	138	}
	139	foreach my $src (keys %$file_neg_regexes) {
	140	my $src_file = $schema_path . '/' . $src . '.pm';
	141	dump_file_not_like($src_file, @{$file_neg_regexes->{$src}});
	142	}
605fcea8	143	}
605fcea8	144
a4187fdf	145	sub dump_file_like {
	146	my $path = shift;
	147	open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
	148	my $contents = do { local $/; <$dumpfh>; };
	149	close($dumpfh);
ff746964	150	my $num = 1;
ff746964	151	like($contents, $_, "like $path " . $num++) for @_;
a4187fdf	152	}
605fcea8	153
a4187fdf	154	sub dump_file_not_like {
	155	my $path = shift;
	156	open(my $dumpfh, '<', $path) or die "Failed to open '$path': $!";
	157	my $contents = do { local $/; <$dumpfh>; };
	158	close($dumpfh);
ff746964	159	my $num = 1;
ff746964	160	unlike($contents, $_, "unlike $path ". $num++) for @_;
605fcea8	161	}
605fcea8	162
a4187fdf	163	sub append_to_class {
	164	my ($class, $string) = @_;
	165	$class =~ s{::}{/}g;
	166	$class = $DUMP_PATH . '/' . $class . '.pm';
	167	open(my $appendfh, '>>', $class) or die "Failed to open '$class' for append: $!";
	168	print $appendfh $string;
	169	close($appendfh);
	170	}
	171
	172	rmtree($DUMP_PATH, 1, 1);
	173
6dde4613	174	# test loading external content
	175	do_dump_test(
	176	classname => 'DBICTest::Schema::13',
6dde4613	177	warnings => [
	178	qr/Dumping manual schema for DBICTest::Schema::13 to directory /,
	179	qr/Schema dump completed/,
	180	],
	181	regexes => {
	182	Foo => [
	183	qr/package DBICTest::Schema::13::Foo;\nour \$skip_me = "bad mojo";\n1;/
	184	],
	185	},
	186	);
	187
	188	# test skipping external content
	189	do_dump_test(
	190	classname => 'DBICTest::Schema::14',
	191	options => { skip_load_external => 1 },
6dde4613	192	warnings => [
	193	qr/Dumping manual schema for DBICTest::Schema::14 to directory /,
	194	qr/Schema dump completed/,
	195	],
	196	neg_regexes => {
	197	Foo => [
	198	qr/package DBICTest::Schema::14::Foo;\nour \$skip_me = "bad mojo";\n1;/
	199	],
	200	},
	201	);
	202
	203	rmtree($DUMP_PATH, 1, 1);
	204
73099af4	205	# test config_file
	206
	207	my ($fh, $config_file) = tempfile;
	208
	209	print $fh <<'EOF';
	210	{ skip_relationships => 1 }
	211	EOF
	212	close $fh;
	213
	214	do_dump_test(
	215	classname => 'DBICTest::Schema::14',
	216	options => { config_file => $config_file },
73099af4	217	warnings => [
	218	qr/Dumping manual schema for DBICTest::Schema::14 to directory /,
	219	qr/Schema dump completed/,
	220	],
	221	neg_regexes => {
	222	Foo => [
	223	qr/has_many/,
	224	],
	225	},
	226	);
	227
	228	unlink $config_file;
	229
f812ef60	230	rmtree($DUMP_PATH, 1, 1);
	231
	232	do_dump_test(
	233	classname => 'DBICTest::Schema::14',
	234	test_db_class => 'make_dbictest_db_clashing_monikers',
	235	error => qr/tables 'bar', 'bars' reduced to the same source moniker 'Bar'/,
	236	);
	237
	238	rmtree($DUMP_PATH, 1, 1);
	239
9de8c789	240	# test out the POD
9de8c789	241
a4187fdf	242	do_dump_test(
a4187fdf	243	classname => 'DBICTest::DumpMore::1',
f170d55b	244	options => {
	245	custom_column_info => sub {
	246	my ($table, $col, $info) = @_;
	247	return +{ extra => { is_footext => 1 } } if $col eq 'footext';
	248	}
	249	},
a4187fdf	250	warnings => [
	251	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	252	qr/Schema dump completed/,
	253	],
	254	regexes => {
	255	schema => [
	256	qr/package DBICTest::DumpMore::1;/,
	257	qr/->load_classes/,
	258	],
	259	Foo => [
9de8c789	260	qr/package DBICTest::DumpMore::1::Foo;/,
	261	qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
	262	qr/=head1 ACCESSORS\n\n/,
9334ac26	263	qr/=head2 fooid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 1\n\n/,
517a30e2	264	qr/=head2 footext\n\n data_type: 'text'\n default_value: 'footext'\n extra: {is_footext => 1}\n is_nullable: 1\n\n/,
9de8c789	265	qr/->set_primary_key/,
	266	qr/=head1 RELATIONS\n\n/,
	267	qr/=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
	268	qr/1;\n$/,
a4187fdf	269	],
a4187fdf	270	Bar => [
9de8c789	271	qr/package DBICTest::DumpMore::1::Bar;/,
	272	qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
	273	qr/=head1 ACCESSORS\n\n/,
9334ac26	274	qr/=head2 barid\n\n data_type: 'integer'\n is_auto_increment: 1\n is_nullable: 1\n\n/,
517a30e2	275	qr/=head2 fooref\n\n data_type: 'integer'\n is_foreign_key: 1\n is_nullable: 1\n\n/,
9de8c789	276	qr/->set_primary_key/,
	277	qr/=head1 RELATIONS\n\n/,
	278	qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
	279	qr/1;\n$/,
a4187fdf	280	],
	281	},
	282	);
	283
	284	append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom content XXX});
	285
	286	do_dump_test(
	287	classname => 'DBICTest::DumpMore::1',
a4187fdf	288	warnings => [
	289	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	290	qr/Schema dump completed/,
	291	],
	292	regexes => {
	293	schema => [
	294	qr/package DBICTest::DumpMore::1;/,
	295	qr/->load_classes/,
	296	],
	297	Foo => [
	298	qr/package DBICTest::DumpMore::1::Foo;/,
	299	qr/->set_primary_key/,
	300	qr/1;\n# XXX This is my custom content XXX/,
	301	],
	302	Bar => [
	303	qr/package DBICTest::DumpMore::1::Bar;/,
	304	qr/->set_primary_key/,
	305	qr/1;\n$/,
	306	],
	307	},
	308	);
605fcea8	309
a4187fdf	310	do_dump_test(
a4187fdf	311	classname => 'DBICTest::DumpMore::1',
28b4691d	312	options => { really_erase_my_files => 1 },
a4187fdf	313	warnings => [
	314	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	315	qr/Deleting existing file /,
	316	qr/Deleting existing file /,
	317	qr/Deleting existing file /,
	318	qr/Schema dump completed/,
	319	],
	320	regexes => {
	321	schema => [
	322	qr/package DBICTest::DumpMore::1;/,
	323	qr/->load_classes/,
	324	],
	325	Foo => [
	326	qr/package DBICTest::DumpMore::1::Foo;/,
	327	qr/->set_primary_key/,
	328	qr/1;\n$/,
	329	],
	330	Bar => [
	331	qr/package DBICTest::DumpMore::1::Bar;/,
	332	qr/->set_primary_key/,
	333	qr/1;\n$/,
	334	],
	335	},
	336	neg_regexes => {
	337	Foo => [
	338	qr/# XXX This is my custom content XXX/,
	339	],
492dce8d	340	},
	341	);
	342
eac5494b	343	rmtree($DUMP_PATH, 1, 1);
eac5494b	344
492dce8d	345	do_dump_test(
	346	classname => 'DBICTest::DumpMore::1',
	347	options => { use_namespaces => 1, generate_pod => 0 },
492dce8d	348	warnings => [
	349	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	350	qr/Schema dump completed/,
	351	],
	352	neg_regexes => {
	353	'Result/Foo' => [
	354	qr/^=/m,
	355	],
a4187fdf	356	},
a4187fdf	357	);
605fcea8	358
eac5494b	359	rmtree($DUMP_PATH, 1, 1);
eac5494b	360
f44ecc2f	361	do_dump_test(
f44ecc2f	362	classname => 'DBICTest::DumpMore::1',
69219349	363	options => { db_schema => 'foo_schema', qualify_objects => 1, use_namespaces => 1 },
	364	warnings => [
	365	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	366	qr/Schema dump completed/,
	367	],
	368	regexes => {
	369	'Result/Foo' => [
	370	qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
414c61a0	371	# the has_many relname should not have the schema in it!
414c61a0	372	qr/^__PACKAGE__->has_many\(\n "bars"/m,
69219349	373	],
	374	},
	375	);
	376
	377	rmtree($DUMP_PATH, 1, 1);
	378
	379	do_dump_test(
	380	classname => 'DBICTest::DumpMore::1',
f44ecc2f	381	options => { use_namespaces => 1 },
f44ecc2f	382	warnings => [
	383	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	384	qr/Schema dump completed/,
	385	],
	386	regexes => {
	387	schema => [
	388	qr/package DBICTest::DumpMore::1;/,
	389	qr/->load_namespaces/,
	390	],
	391	'Result/Foo' => [
	392	qr/package DBICTest::DumpMore::1::Result::Foo;/,
	393	qr/->set_primary_key/,
	394	qr/1;\n$/,
	395	],
	396	'Result/Bar' => [
	397	qr/package DBICTest::DumpMore::1::Result::Bar;/,
	398	qr/->set_primary_key/,
	399	qr/1;\n$/,
	400	],
	401	},
	402	);
	403
eac5494b	404	rmtree($DUMP_PATH, 1, 1);
eac5494b	405
f44ecc2f	406	do_dump_test(
	407	classname => 'DBICTest::DumpMore::1',
	408	options => { use_namespaces => 1,
	409	result_namespace => 'Res',
	410	resultset_namespace => 'RSet',
	411	default_resultset_class => 'RSetBase',
	412	},
f44ecc2f	413	warnings => [
	414	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	415	qr/Schema dump completed/,
	416	],
	417	regexes => {
	418	schema => [
	419	qr/package DBICTest::DumpMore::1;/,
	420	qr/->load_namespaces/,
	421	qr/result_namespace => 'Res'/,
	422	qr/resultset_namespace => 'RSet'/,
	423	qr/default_resultset_class => 'RSetBase'/,
	424	],
	425	'Res/Foo' => [
	426	qr/package DBICTest::DumpMore::1::Res::Foo;/,
	427	qr/->set_primary_key/,
	428	qr/1;\n$/,
	429	],
	430	'Res/Bar' => [
	431	qr/package DBICTest::DumpMore::1::Res::Bar;/,
	432	qr/->set_primary_key/,
	433	qr/1;\n$/,
	434	],
	435	},
	436	);
	437
eac5494b	438	rmtree($DUMP_PATH, 1, 1);
eac5494b	439
f44ecc2f	440	do_dump_test(
	441	classname => 'DBICTest::DumpMore::1',
	442	options => { use_namespaces => 1,
	443	result_namespace => '+DBICTest::DumpMore::1::Res',
	444	resultset_namespace => 'RSet',
	445	default_resultset_class => 'RSetBase',
9c9c2f2b	446	result_base_class => 'My::ResultBaseClass',
9c9c2f2b	447	schema_base_class => 'My::SchemaBaseClass',
f44ecc2f	448	},
f44ecc2f	449	warnings => [
	450	qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
	451	qr/Schema dump completed/,
	452	],
	453	regexes => {
	454	schema => [
	455	qr/package DBICTest::DumpMore::1;/,
	456	qr/->load_namespaces/,
	457	qr/result_namespace => '\+DBICTest::DumpMore::1::Res'/,
	458	qr/resultset_namespace => 'RSet'/,
	459	qr/default_resultset_class => 'RSetBase'/,
9c9c2f2b	460	qr/use base 'My::SchemaBaseClass'/,
f44ecc2f	461	],
	462	'Res/Foo' => [
	463	qr/package DBICTest::DumpMore::1::Res::Foo;/,
9c9c2f2b	464	qr/use base 'My::ResultBaseClass'/,
f44ecc2f	465	qr/->set_primary_key/,
	466	qr/1;\n$/,
	467	],
	468	'Res/Bar' => [
	469	qr/package DBICTest::DumpMore::1::Res::Bar;/,
9c9c2f2b	470	qr/use base 'My::ResultBaseClass'/,
f44ecc2f	471	qr/->set_primary_key/,
	472	qr/1;\n$/,
	473	],
	474	},
	475	);
c634fde9	476
eac5494b	477	rmtree($DUMP_PATH, 1, 1);
eac5494b	478
8048320c	479	do_dump_test(
	480	classname => 'DBICTest::DumpMore::1',
	481	options => {
	482	use_namespaces => 1,
	483	result_base_class => 'My::MissingResultBaseClass',
	484	},
	485	error => qr/My::MissingResultBaseClass.*is not installed/,
	486	);
f44ecc2f	487
d27f2b7b	488	done_testing;
d27f2b7b	489
9de8c789	490	END { rmtree($DUMP_PATH, 1, 1) unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} }
69219349	491	# vim:et sts=4 sw=4 tw=0: