use Test::More;
use DBIx::Class::Schema::Loader;
+use Class::Unload;
+use File::Path;
use DBI;
+my $DUMP_DIR = './t/_common_dump';
+rmtree $DUMP_DIR;
+
sub new {
my $class = shift;
sub run_tests {
my $self = shift;
- plan tests => 134 + ($self->{extra}->{count} || 0);
+ plan tests => 3 + 2 * (132 + ($self->{extra}->{count} || 0));
$self->create();
+ my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} );
+
+ # First, with in-memory classes
+ my $schema_class = $self->setup_schema(@connect_info);
+ $self->test_schema($schema_class);
+
+ # Then, with dumped classes
+ $self->drop_tables;
+ $self->create;
+ $self->{dump} = 1;
+
+ unshift @INC, $DUMP_DIR;
+ $self->reload_schema($schema_class);
+ $schema_class->connection(@connect_info);
+ $self->test_schema($schema_class);
+}
+
+sub setup_schema {
+ my $self = shift;
+ my @connect_info = @_;
+
my $schema_class = 'DBIXCSL_Test::Schema';
my $debug = ($self->{verbose} > 1) ? 1 : 0;
- my @connect_info = ( $self->{dsn}, $self->{user}, $self->{password} );
my %loader_opts = (
- constraint => qr/^(?:\S+\.)?(?:$self->{vendor}_)?loader_test[0-9]+$/i,
+ constraint => qr/^(?:\S+\.)?(?:$self->{vendor}_)?loader_test[0-9]+s?$/i,
relationships => 1,
additional_classes => 'TestAdditional',
additional_base_classes => 'TestAdditionalBase',
left_base_classes => [ qw/TestLeftBase/ ],
components => [ qw/TestComponent/ ],
+ resultset_components => [ qw/TestRSComponent/ ],
inflect_plural => { loader_test4 => 'loader_test4zes' },
inflect_singular => { fkid => 'fkid_singular' },
moniker_map => \&_monikerize,
debug => $debug,
+ dump_directory => $DUMP_DIR,
);
$loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
- eval { require Class::Inspector };
- if($@) {
- $self->{_no_rs_components} = 1;
- }
- else {
- $loader_opts{resultset_components} = [ qw/TestRSComponent/ ];
- }
{
my @loader_warnings;
__PACKAGE__->loader_options(\%loader_opts);
__PACKAGE__->connection(\@connect_info);
};
+
ok(!$@, "Loader initialization") or diag $@;
if($self->{skip_rels}) {
SKIP: {
- is(scalar(@loader_warnings), 0, "No loader warnings")
+ is(scalar(@loader_warnings), 2, "No loader warnings")
or diag @loader_warnings;
skip "No missing PK warnings without rels", 1;
}
}
else {
- is(scalar(@loader_warnings), 1, "Expected loader warning")
+ is(scalar(@loader_warnings), 3, "Expected loader warning")
or diag @loader_warnings;
like($loader_warnings[0], qr/loader_test9 has no primary key/i,
"Missing PK warning");
}
}
+
+ return $schema_class;
+}
+
+sub test_schema {
+ my $self = shift;
+ my $schema_class = shift;
my $conn = $schema_class->clone;
my $monikers = {};
$classes->{$table_name} = $schema_class . q{::} . $source_name;
}
- my $moniker1 = $monikers->{loader_test1};
- my $class1 = $classes->{loader_test1};
+ my $moniker1 = $monikers->{loader_test1s};
+ my $class1 = $classes->{loader_test1s};
my $rsobj1 = $conn->resultset($moniker1);
my $moniker2 = $monikers->{loader_test2};
}
ok($uniq1_test, "Unique constraint");
+ is($moniker1, 'LoaderTest1', 'moniker singularisation');
+
my %uniq2 = $class2->unique_constraints;
my $uniq2_test = 0;
foreach my $ucname (keys %uniq2) {
is($moniker2, 'LoaderTest2X', "moniker_map testing");
- {
- my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth,
- $skip_rsmeth, $skip_tcomp, $skip_trscomp);
-
- can_ok( $class1, 'test_additional_base' ) or $skip_tab = 1;
- can_ok( $class1, 'test_additional_base_override' ) or $skip_tabo = 1;
- can_ok( $class1, 'test_additional_base_additional' ) or $skip_taba = 1;
- can_ok( $class1, 'dbix_class_testcomponent' ) or $skip_tcomp = 1;
- can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1;
-
- TODO: {
- local $TODO = "Not yet supported by ResultSetManger code";
- can_ok( $rsobj1, 'loader_test1_rsmeth' ) or $skip_rsmeth = 1;
- }
-
- SKIP: {
- skip "Pre-requisite test failed", 1 if $skip_tab;
- is( $class1->test_additional_base, "test_additional_base",
- "Additional Base method" );
- }
-
- SKIP: {
- skip "Pre-requisite test failed", 1 if $skip_tabo;
- is( $class1->test_additional_base_override,
- "test_left_base_override",
- "Left Base overrides Additional Base method" );
- }
-
- SKIP: {
- skip "Pre-requisite test failed", 1 if $skip_taba;
- is( $class1->test_additional_base_additional, "test_additional",
- "Additional Base can use Additional package method" );
- }
+ SKIP: {
+ can_ok( $class1, 'test_additional_base' )
+ or skip "Pre-requisite test failed", 1;
+ is( $class1->test_additional_base, "test_additional_base",
+ "Additional Base method" );
+ }
- SKIP: {
- skip "Pre-requisite test failed", 1 if $skip_tcomp;
- is( $class1->dbix_class_testcomponent,
- 'dbix_class_testcomponent works',
- 'Additional Component' );
- }
+ SKIP: {
+ can_ok( $class1, 'test_additional_base_override' )
+ or skip "Pre-requisite test failed", 1;
+ is( $class1->test_additional_base_override,
+ "test_left_base_override",
+ "Left Base overrides Additional Base method" );
+ }
- SKIP: {
- skip "These two tests need Class::Inspector installed", 2
- if $self->{_no_rs_components};
- can_ok($rsobj1, 'dbix_class_testrscomponent') or $skip_trscomp = 1;
- SKIP: {
- skip "Pre-requisite test failed", 1 if $skip_trscomp;
- is( $rsobj1->dbix_class_testrscomponent,
- 'dbix_class_testrscomponent works',
- 'ResultSet component' );
- }
- }
+ SKIP: {
+ can_ok( $class1, 'test_additional_base_additional' )
+ or skip "Pre-requisite test failed", 1;
+ is( $class1->test_additional_base_additional, "test_additional",
+ "Additional Base can use Additional package method" );
+ }
- SKIP: {
- skip "Pre-requisite test failed", 1 if $skip_cmeth;
- is( $class1->loader_test1_classmeth, 'all is well', 'Class method' );
- }
+ SKIP: {
+ can_ok( $class1, 'dbix_class_testcomponent' )
+ or skip "Pre-requisite test failed", 1;
+ is( $class1->dbix_class_testcomponent,
+ 'dbix_class_testcomponent works',
+ 'Additional Component' );
+ }
- SKIP: {
- skip "Pre-requisite test failed", 1 if $skip_rsmeth;
- is( $rsobj1->loader_test1_rsmeth, 'all is still well', 'Result set method' );
- }
+ SKIP: {
+ can_ok($rsobj1, 'dbix_class_testrscomponent')
+ or skip "Pre-requisite test failed", 1;
+ is( $rsobj1->dbix_class_testrscomponent,
+ 'dbix_class_testrscomponent works',
+ 'ResultSet component' );
}
SKIP: {
- skip "This vendor doesn't detect auto-increment columns", 1
- if $self->{no_auto_increment};
+ can_ok( $class1, 'loader_test1_classmeth' )
+ or skip "Pre-requisite test failed", 1;
+ is( $class1->loader_test1_classmeth, 'all is well', 'Class method' );
+ }
- ok( $class1->column_info('id')->{is_auto_increment}, 'is_auto_incrment detection' );
+ SKIP: {
+ can_ok( $rsobj1, 'loader_test1_rsmeth' )
+ or skip "Pre-requisite test failed";
+ is( $rsobj1->loader_test1_rsmeth, 'all is still well', 'Result set method' );
}
+
+ ok( $class1->column_info('id')->{is_auto_increment}, 'is_auto_incrment detection' );
my $obj = $rsobj1->find(1);
is( $obj->id, 1, "Find got the right row" );
isa_ok( $obj6->loader_test2, $class2);
isa_ok( $obj6->loader_test5, $class5);
- ok($class6->column_info('loader_test2')->{is_foreign_key}, 'Foreign key detected');
+ ok($class6->column_info('loader_test2_id')->{is_foreign_key}, 'Foreign key detected');
ok($class6->column_info('id')->{is_foreign_key}, 'Foreign key detected');
ok($class6->column_info('id2')->{is_foreign_key}, 'Foreign key detected');
# rescan test
SKIP: {
- skip $self->{skip_rels}, 5 if $self->{skip_rels};
+ skip $self->{skip_rels}, 4 if $self->{skip_rels};
+ skip "Can't rescan dumped schema", 4 if $self->{dump};
my @statements_rescan = (
qq{
my $make_auto_inc = $self->{auto_inc_cb} || sub {};
my @statements = (
qq{
- CREATE TABLE loader_test1 (
+ CREATE TABLE loader_test1s (
id $self->{auto_inc_pk},
dat VARCHAR(32) NOT NULL UNIQUE
) $self->{innodb}
},
- $make_auto_inc->(qw/loader_test1 id/),
+ $make_auto_inc->(qw/loader_test1s id/),
- q{ INSERT INTO loader_test1 (dat) VALUES('foo') },
- q{ INSERT INTO loader_test1 (dat) VALUES('bar') },
- q{ INSERT INTO loader_test1 (dat) VALUES('baz') },
+ q{ INSERT INTO loader_test1s (dat) VALUES('foo') },
+ q{ INSERT INTO loader_test1s (dat) VALUES('bar') },
+ q{ INSERT INTO loader_test1s (dat) VALUES('baz') },
qq{
CREATE TABLE loader_test2 (
CREATE TABLE loader_test6 (
id INTEGER NOT NULL PRIMARY KEY,
Id2 INTEGER,
- loader_test2 INTEGER,
+ loader_test2_id INTEGER,
dat VARCHAR(8),
- FOREIGN KEY (loader_test2) REFERENCES loader_test2 (id),
+ FOREIGN KEY (loader_test2_id) REFERENCES loader_test2 (id),
FOREIGN KEY(id,Id2) REFERENCES loader_test5 (id1,iD2)
) $self->{innodb}
},
- (q{ INSERT INTO loader_test6 (id, id2,loader_test2,dat) } .
+ (q{ INSERT INTO loader_test6 (id, id2,loader_test2_id,dat) } .
q{ VALUES (1, 1,1,'aaa') }),
qq{
my $self = shift;
my @tables = qw/
- loader_test1
+ loader_test1s
loader_test2
LOADER_TEST23
LoAdEr_test24
/;
my @tables_auto_inc = (
- [ qw/loader_test1 id/ ],
+ [ qw/loader_test1s id/ ],
[ qw/loader_test2 id/ ],
);
$dbh->disconnect;
}
+sub reload_schema {
+ my ($self, $schema) = @_;
+
+ for my $source ($schema->sources) {
+ Class::Unload->unload( $schema->class( $source ) );
+ Class::Unload->unload( ref $schema->resultset( $source ) );
+ }
+
+ Class::Unload->unload( $schema );
+ eval "require $schema" or die $@;
+}
+
sub DESTROY {
my $self = shift;
$self->drop_tables if $self->{_created};
+ rmtree $DUMP_DIR;
}
1;