sub run_tests {
my $self = shift;
- plan tests => 89;
+ plan tests => 97;
$self->create();
);
$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;
$warn_count++ if grep /Dynamic schema detected/, @loader_warnings;
$warn_count++ for grep /^Bad table or view/, @loader_warnings;
- if($self->{skip_rels}) {
- is(scalar(@loader_warnings), $warn_count)
- or diag "Did not get the expected 0 warnings. Warnings are: "
- . join('',@loader_warnings);
- ok(1);
- }
- else {
- $warn_count++;
- is(scalar(@loader_warnings), $warn_count)
- or diag "Did not get the expected 1 warning. Warnings are: "
- . join('',@loader_warnings);
- is(grep(/loader_test9 has no primary key/, @loader_warnings), 1);
- }
+ is(scalar(@loader_warnings), $warn_count)
+ or diag "Did not get the expected 0 warnings. Warnings are: "
+ . join('',@loader_warnings);
}
my $conn = $schema_class->clone;
my $monikers = {};
my $classes = {};
foreach my $source_name ($schema_class->sources) {
- my $table_name = $schema_class->source($source_name)->from;
+ my $table_name = $schema_class->loader->moniker_to_table->{$source_name};
+
+ my $result_class = $schema_class->source($source_name)->result_class;
+
$monikers->{$table_name} = $source_name;
- $classes->{$table_name} = $schema_class . q{::} . $source_name;
+ $classes->{$table_name} = $result_class;
+
+ # some DBs (Firebird, Oracle) uppercase everything
+ $monikers->{lc $table_name} = $source_name;
+ $classes->{lc $table_name} = $result_class;
}
# for debugging...
{
my ($skip_tab, $skip_tabo, $skip_taba, $skip_cmeth,
- $skip_rsmeth, $skip_tcomp, $skip_trscomp);
+ $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, 'dbix_class_testcomponent' ) or $skip_tcomp = 1;
can_ok( $class1, 'loader_test1_classmeth' ) or $skip_cmeth = 1;
- 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",
}
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' );
- }
- }
-
- SKIP: {
skip "Pre-requisite test failed", 1 if $skip_cmeth;
is( $class1->loader_test1_classmeth, 'all is well' );
}
-
- # XXX put this back in when the TODO above works...
- #SKIP: {
- # skip "Pre-requisite test failed", 1 if $skip_rsmeth;
- # is( $rsobj1->loader_test1_rsmeth, 'all is still well' );
- #}
}
is( $obj2->id, 2 );
SKIP: {
- skip $self->{skip_rels}, 50 if $self->{skip_rels};
+ skip $self->{skip_rels}, 63 if $self->{skip_rels};
my $moniker3 = $monikers->{loader_test3};
my $class3 = $classes->{loader_test3};
my $rs_rel4 = $obj3->search_related('loader_test4zes');
isa_ok( $rs_rel4->first, $class4);
+ # test that _id is not stripped and prepositions in rel names are
+ # ignored
+ ok ($rsobj4->result_source->has_relationship('loader_test5_to_ids'),
+ "rel with preposition 'to' and _id pluralized backward-compatibly");
+
+ ok ($rsobj4->result_source->has_relationship('loader_test5_from_ids'),
+ "rel with preposition 'from' and _id pluralized backward-compatibly");
+
+ # check that default relationship attributes are not applied in 0.04006 mode
+ is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_delete}, 1,
+ 'cascade_delete => 1 on has_many by default';
+
+ is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_copy}, 1,
+ 'cascade_copy => 1 on has_many by default';
+
+ ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_delete}),
+ 'has_many does not have on_delete');
+
+ ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_update}),
+ 'has_many does not have on_update');
+
+ ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{is_deferrable}),
+ 'has_many does not have is_deferrable');
+
+ isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_delete}, 'CASCADE',
+ "on_delete => 'CASCADE' not on belongs_to by default";
+
+ isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update}, 'CASCADE',
+ "on_update => 'CASCADE' not on belongs_to by default";
+
+ isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}, 1,
+ "is_deferrable => 1 not on belongs_to by default";
+
+ ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_delete}),
+ 'belongs_to does not have cascade_delete');
+
+ ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_copy}),
+ 'belongs_to does not have cascade_copy');
+
# find on multi-col pk
my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
is( $obj5->id2, 1 );
$obj10_2->loader_test11( $obj11->id11() );
$obj10_2->update();
};
- is($@, '', 'No errors after eval{}');
+ is($@, '', 'No errors after eval{}')
+ or do {
+ diag explain $rsobj10->result_source->relationship_info('loader_test11');
+ diag explain $rsobj11->result_source->relationship_info('loader_test10');
+ };
SKIP: {
skip 'Previous eval block failed', 3
);
{
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
-
my $dbh = $self->dbconnect(1);
$dbh->do($_) for @statements_rescan;
$dbh->disconnect;
}
- my @new = $conn->rescan;
+ my @new = do {
+ local $SIG{__WARN__} = sub {};
+ $conn->rescan;
+ };
is(scalar(@new), 1);
is($new[0], 'LoaderTest30');
AutoCommit => 1,
}
);
+ if ($self->{dsn} =~ /^[^:]+:SQLite:/) {
+ $dbh->do ('PRAGMA synchronous = OFF');
+ }
+ elsif ($self->{dsn} =~ /^[^:]+:Pg:/) {
+ $dbh->do ('SET client_min_messages=WARNING');
+ }
die "Failed to connect to database: $DBI::errstr" if !$dbh;
id1 INTEGER NOT NULL,
iD2 INTEGER NOT NULL,
dat VARCHAR(8),
- PRIMARY KEY (id1,id2)
+ from_id INTEGER,
+ to_id INTEGER,
+ PRIMARY KEY (id1,id2),
+ FOREIGN KEY (from_id) REFERENCES loader_test4 (id),
+ FOREIGN KEY (to_id) REFERENCES loader_test4 (id)
) $self->{innodb}
},
my $dbh = $self->dbconnect(1);
- # Silence annoying but harmless postgres "NOTICE: CREATE TABLE..."
- local $SIG{__WARN__} = sub {
- my $msg = shift;
- warn $msg unless $msg =~ m{^NOTICE:\s+CREATE TABLE};
- };
-
$dbh->do($_) for (@statements);
unless($self->{skip_rels}) {
# hack for now, since DB2 doesn't like inline comments, and we need
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff