my $extra_count = $self->{extra}{count} || 0;
my $col_accessor_map_tests = 5;
- my $num_rescans = 5;
+ my $num_rescans = 6;
$num_rescans++ if $self->{vendor} eq 'mssql';
$num_rescans++ if $self->{vendor} eq 'Firebird';
plan tests => @connect_info *
- (210 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+ (221 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
foreach my $info_idx (0..$#connect_info) {
my $info = $connect_info[$info_idx];
@statements_advanced_sqlite, @statements_inline_rels,
@statements_implicit_rels);
+sub CONSTRAINT {
+ my $self = shift;
+return qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i;
+}
+
sub setup_schema {
my ($self, $connect_info, $expected_count) = @_;
}
my %loader_opts = (
- constraint =>
- qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i,
+ constraint => $self->CONSTRAINT,
result_namespace => RESULT_NAMESPACE,
resultset_namespace => RESULTSET_NAMESPACE,
+ schema_base_class => 'TestSchemaBaseClass',
schema_components => [ 'TestSchemaComponent', '+TestSchemaComponentFQN' ],
additional_classes => 'TestAdditional',
additional_base_classes => 'TestAdditionalBase',
left_base_classes => [ qw/TestLeftBase/ ],
- components => [ qw/TestComponent +TestComponentFQN/ ],
+ components => [ qw/TestComponent +TestComponentFQN IntrospectableM2M/ ],
inflect_plural => { loader_test4_fkid => 'loader_test4zes' },
inflect_singular => { fkid => 'fkid_singular' },
moniker_map => \&_monikerize,
'resultset_namespace set correctly on Schema';
like $schema_code,
+qr/\nuse base 'TestSchemaBaseClass';\n\n|\nextends 'TestSchemaBaseClass';\n\n/,
+ 'schema_base_class works';
+
+ is $conn->testschemabaseclass, 'TestSchemaBaseClass works',
+ 'schema base class works';
+
+ like $schema_code,
qr/\n__PACKAGE__->load_components\("TestSchemaComponent", "\+TestSchemaComponentFQN"\);\n\n__PACKAGE__->load_namespaces/,
'schema_components works';
+ is $conn->dbix_class_testschemacomponent, 'dbix_class_testschemacomponent works',
+ 'schema component works';
+
+ is $conn->testschemacomponent_fqn, 'TestSchemaComponentFQN works',
+ 'fully qualified schema component works';
+
my @columns_lt2 = $class2->columns;
is_deeply( \@columns_lt2, [ qw/id dat dat2 set_primary_key can dbix_class_testcomponent dbix_class_testcomponentmap testcomponent_fqn meta test_role_method test_role_for_map_method crumb_crisp_coating/ ], "Column Ordering" );
'is_nullable=1 detection';
SKIP: {
- skip $self->{skip_rels}, 131 if $self->{skip_rels};
+ skip $self->{skip_rels}, 137 if $self->{skip_rels};
my $moniker3 = $monikers->{loader_test3};
my $class3 = $classes->{loader_test3};
ok($class22->column_info('parent')->{is_foreign_key}, 'Foreign key detected');
ok($class22->column_info('child')->{is_foreign_key}, 'Foreign key detected');
+ # test many_to_many detection 18 -> 20 -> 19 and 19 -> 20 -> 18
+ my $m2m;
+
+ ok($m2m = (try { $class18->_m2m_metadata->{children} }), 'many_to_many created');
+
+ is $m2m->{relation}, 'loader_test20s', 'm2m near rel';
+ is $m2m->{foreign_relation}, 'child', 'm2m far rel';
+
+ ok($m2m = (try { $class19->_m2m_metadata->{parents} }), 'many_to_many created');
+
+ is $m2m->{relation}, 'loader_test20s', 'm2m near rel';
+ is $m2m->{foreign_relation}, 'parent', 'm2m far rel';
+
# test double multi-col fk 26 -> 25
my $obj26 = try { $rsobj26->find(33) } || $rsobj26->search({ id => 33 })->first;
# run extra tests
$self->{extra}{run}->($conn, $monikers, $classes, $self) if $self->{extra}{run};
+ ## Create a dump from an existing $dbh in a transaction
+
+TODO: {
+ local $TODO = 'dumping in a txn is experimental and Pg-only right now'
+ unless $self->{vendor} eq 'Pg';
+
+ ok eval {
+ my %opts = (
+ naming => 'current',
+ constraint => $self->CONSTRAINT,
+ dump_directory => DUMP_DIR,
+ debug => ($ENV{SCHEMA_LOADER_TESTS_DEBUG}||0)
+ );
+
+ my $guard = $conn->txn_scope_guard;
+
+ my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+ local $SIG{__WARN__} = sub {
+ $warn_handler->(@_)
+ unless $_[0] =~ RESCAN_WARNINGS
+ || $_[0] =~ /commit ineffective with AutoCommit enabled/; # FIXME
+ };
+
+ my $schema_from = DBIx::Class::Schema::Loader::make_schema_at(
+ "TestSchemaFromAnother", \%opts, [ sub { $conn->storage->dbh } ]
+ );
+
+ $guard->commit;
+
+ 1;
+ }, 'Making a schema from another schema inside a transaction worked';
+
+ diag $@ if $@ && (not $TODO);
+}
+
$self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};
$conn->storage->disconnect;
);
$conn->storage->disconnect;
- local $conn->loader->{preserve_case} = 1;
- $conn->loader->_setup;
+ my $orig_preserve_case = $conn->loader->preserve_case;
+ $conn->loader->preserve_case(1);
+ $conn->loader->_setup;
$self->rescan_without_warnings($conn);
if (not $self->{skip_rels}) {
is try { $conn->resultset('LoaderTest40')->find(1)->foo3_bar }, 'foo',
'accessor for mixed-case column name in mixed case table';
}
+
+ # Further tests may expect preserve_case to be unset, so reset it to the
+ # original value and rescan again.
+
+ $conn->loader->preserve_case($orig_preserve_case);
+ $conn->loader->_setup;
+ $self->rescan_without_warnings($conn);
}
sub monikers_and_classes {
$monikers->{$table_name} = $source_name;
$classes->{$table_name} = $result_class;
- # some DBs (Firebird) uppercase everything
+ # some DBs (Firebird, Oracle) uppercase everything
$monikers->{lc $table_name} = $source_name;
$classes->{lc $table_name} = $result_class;
}
$self->drop_tables;
- my $make_auto_inc = $self->{auto_inc_cb} || sub {};
+ my $make_auto_inc = $self->{auto_inc_cb} || sub { return () };
@statements = (
qq{
CREATE TABLE loader_test1s (
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff