use List::MoreUtils 'apply';
use DBIx::Class::Schema::Loader::Optional::Dependencies ();
use Try::Tiny;
-use File::Slurp 'slurp';
+use File::Slurp 'read_file';
+use File::Spec::Functions 'catfile';
+use File::Basename 'basename';
use namespace::clean;
use dbixcsl_test_dir qw/$tdir/;
-my $DUMP_DIR = "$tdir/common_dump";
-rmtree $DUMP_DIR;
+use constant DUMP_DIR => "$tdir/common_dump";
+
+rmtree DUMP_DIR;
use constant RESCAN_WARNINGS => qr/(?i:loader_test|LoaderTest)\d+s? has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement|^Bad table or view/;
+# skip schema-qualified tables in the Pg tests
use constant SOURCE_DDL => qr/CREATE (?:TABLE|VIEW) (?!"dbicsl[.-]test")/i;
+use constant SCHEMA_CLASS => 'DBIXCSL_Test::Schema';
+
+use constant RESULT_NAMESPACE => [ 'MyResult', 'MyResultTwo' ];
+
+use constant RESULTSET_NAMESPACE => [ 'MyResultSet', 'MyResultSetTwo' ];
+
sub new {
my $class = shift;
my $col_accessor_map_tests = 5;
my $num_rescans = 5;
- $num_rescans-- if $self->{vendor} eq 'Mysql';
$num_rescans++ if $self->{vendor} eq 'mssql';
$num_rescans++ if $self->{vendor} eq 'Firebird';
plan tests => @connect_info *
- (203 + $num_rescans * $col_accessor_map_tests + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+ (209 + $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];
my $schema_class = $self->setup_schema($info);
$self->test_schema($schema_class);
- rmtree $DUMP_DIR
+ rmtree DUMP_DIR
unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#connect_info;
}
}
sub run_only_extra_tests {
my ($self, $connect_info) = @_;
- plan tests => @$connect_info * (4 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0));
+ plan tests => @$connect_info * (3 + ($self->{extra}{count} || 0) + ($self->{data_type_tests}{test_count} || 0));
- rmtree $DUMP_DIR;
+ rmtree DUMP_DIR;
foreach my $info_idx (0..$#$connect_info) {
my $info = $connect_info->[$info_idx];
if (not ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#$connect_info)) {
$self->drop_extra_tables_only;
- rmtree $DUMP_DIR;
+ rmtree DUMP_DIR;
}
}
}
sub setup_schema {
my ($self, $connect_info, $expected_count) = @_;
- my $schema_class = 'DBIXCSL_Test::Schema';
-
my $debug = ($self->{verbose} > 1) ? 1 : 0;
if ($ENV{SCHEMA_LOADER_TESTS_USE_MOOSE}) {
my %loader_opts = (
constraint =>
qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i,
- relationships => 1,
+ result_namespace => RESULT_NAMESPACE,
+ resultset_namespace => RESULTSET_NAMESPACE,
additional_classes => 'TestAdditional',
additional_base_classes => 'TestAdditionalBase',
left_base_classes => [ qw/TestLeftBase/ ],
moniker_map => \&_monikerize,
custom_column_info => \&_custom_column_info,
debug => $debug,
- use_namespaces => 0,
- dump_directory => $DUMP_DIR,
+ dump_directory => DUMP_DIR,
datetime_timezone => 'Europe/Berlin',
datetime_locale => 'de_DE',
$self->{use_moose} ? (
rel_collision_map => { '^(set_primary_key)\z' => 'caught_rel_collision_%s' },
col_accessor_map => \&test_col_accessor_map,
result_components_map => { LoaderTest2X => 'TestComponentForMap', LoaderTest1 => '+TestComponentForMapFQN' },
+ uniq_to_primary => 1,
%{ $self->{loader_options} || {} },
);
$loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema};
- Class::Unload->unload($schema_class);
+ Class::Unload->unload(SCHEMA_CLASS);
my $file_count;
{
my @loader_warnings;
local $SIG{__WARN__} = sub { push(@loader_warnings, @_); };
eval qq{
- package $schema_class;
+ package @{[SCHEMA_CLASS]};
use base qw/DBIx::Class::Schema::Loader/;
__PACKAGE__->loader_options(\%loader_opts);
ok(!$@, "Loader initialization") or diag $@;
- find sub { return if -d; $file_count++ }, $DUMP_DIR;
+ find sub { return if -d; $file_count++ }, DUMP_DIR;
my $standard_sources = not defined $expected_count;
if ($standard_sources) {
- $expected_count = 36;
+ $expected_count = 37;
if (not ($self->{vendor} eq 'mssql' && $connect_info->[0] =~ /Sybase/)) {
$expected_count++ for @{ $self->{data_type_tests}{table_names} || [] };
}
- # skip schema-qualified tables
$expected_count += grep $_ =~ SOURCE_DDL,
@{ $self->{extra}{create} || [] };
$warn_count-- for grep { my $w = $_; grep $w =~ $_, @{ $self->{failtrigger_warnings} || [] } } @loader_warnings;
- if ($standard_sources) {
- if($self->{skip_rels}) {
- SKIP: {
- is(scalar(@loader_warnings), $warn_count, "No loader warnings")
- or diag @loader_warnings;
- skip "No missing PK warnings without rels", 1;
- }
- }
- else {
- $warn_count++;
- is(scalar(@loader_warnings), $warn_count, "Expected loader warning")
- or diag @loader_warnings;
- is(grep(/loader_test9 has no primary key/i, @loader_warnings), 1,
- "Missing PK warning");
- }
- }
- else {
- SKIP: {
- is scalar(@loader_warnings), $warn_count, 'Correct number of warnings'
- or diag @loader_warnings;
- skip "not testing standard sources", 1;
- }
- }
+ is scalar(@loader_warnings), $warn_count, 'Correct number of warnings'
+ or diag @loader_warnings;
}
exit if ($file_count||0) != $expected_count;
-
- return $schema_class;
+
+ return SCHEMA_CLASS;
}
sub test_schema {
my $class35 = $classes->{loader_test35};
my $rsobj35 = $conn->resultset($moniker35);
+ my $moniker50 = $monikers->{loader_test50};
+ my $class50 = $classes->{loader_test50};
+ my $rsobj50 = $conn->resultset($moniker50);
+
isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
isa_ok( $rsobj23, "DBIx::Class::ResultSet" );
isa_ok( $rsobj24, "DBIx::Class::ResultSet" );
isa_ok( $rsobj35, "DBIx::Class::ResultSet" );
+ isa_ok( $rsobj50, "DBIx::Class::ResultSet" );
+
+ # check result_namespace
+ my @schema_dir = split /::/, SCHEMA_CLASS;
+ my $result_dir = ref RESULT_NAMESPACE ? ${RESULT_NAMESPACE()}[0] : RESULT_NAMESPACE;
+
+ my $schema_files = [ sort map basename($_), glob catfile(DUMP_DIR, @schema_dir, '*') ];
+
+ is_deeply $schema_files, [ $result_dir ],
+ 'first entry in result_namespace exists as a directory';
+
+ my $result_file_count =()= glob catfile(DUMP_DIR, @schema_dir, $result_dir, '*.pm');
+
+ ok $result_file_count,
+ 'Result files dumped to first entry in result_namespace';
+
+ # parse out the resultset_namespace
+ my $schema_code = read_file($conn->_loader->get_dump_filename(SCHEMA_CLASS), binmode => ':encoding(UTF-8)');
+
+ my ($schema_resultset_namespace) = $schema_code =~ /\bresultset_namespace => (.*)/;
+ $schema_resultset_namespace = eval $schema_resultset_namespace;
+ die $@ if $@;
+
+ is_deeply $schema_resultset_namespace, RESULTSET_NAMESPACE,
+ 'resultset_namespace set correctly on Schema';
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/ ], "Column Ordering" );
+ 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 $class2->column_info('can')->{accessor}, 'caught_collision_can',
'accessor for column name that conflicts with a UNIVERSAL method renamed based on col_collision_map';
}
ok($uniq2_test, "Multi-col unique constraint");
+ my %uniq3 = $class50->unique_constraints;
+
+ is_deeply $uniq3{primary}, ['id1', 'id2'],
+ 'unique constraint promoted to primary key with uniq_to_primary';
+
is($moniker2, 'LoaderTest2X', "moniker_map testing");
SKIP: {
);
}
+ is( $class2->column_info('crumb_crisp_coating')->{accessor}, 'trivet',
+ 'col_accessor_map is being run' );
+
+ is $class1->column_info('dat')->{is_nullable}, 0,
+ 'is_nullable=0 detection';
+
+ is $class2->column_info('set_primary_key')->{is_nullable}, 1,
+ 'is_nullable=1 detection';
+
SKIP: {
- skip $self->{skip_rels}, 124 if $self->{skip_rels};
+ skip $self->{skip_rels}, 131 if $self->{skip_rels};
my $moniker3 = $monikers->{loader_test3};
my $class3 = $classes->{loader_test3};
my $rs_rel4 = try { $obj3->search_related('loader_test4zes') };
isa_ok( try { $rs_rel4->first }, $class4);
- is( $class4->column_info('crumb_crisp_coating')->{accessor}, 'trivet',
- 'col_accessor_map is being run' );
-
# check rel naming with prepositions
ok ($rsobj4->result_source->has_relationship('loader_test5s_to'),
"rel with preposition 'to' pluralized correctly");
$class6->column_info('Id2');
ok($id2_info->{is_foreign_key}, 'Foreign key detected');
- unlike slurp($conn->_loader->get_dump_filename($class6)),
+ unlike read_file($conn->_loader->get_dump_filename($class6), binmode => ':encoding(UTF-8)'),
qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
\s+ "(\w+?)"
.*?
\s+ "\1"/xs,
'did not create two relationships with the same name';
- unlike slurp($conn->_loader->get_dump_filename($class8)),
+ unlike read_file($conn->_loader->get_dump_filename($class8), binmode => ':encoding(UTF-8)'),
qr/\n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
\s+ "(\w+?)"
.*?
}
SKIP: {
- skip 'This vendor cannot do inline relationship definitions', 11
+ skip 'This vendor cannot do inline relationship definitions', 9
if $self->{no_inline_rels};
my $moniker12 = $monikers->{loader_test12};
my $obj12 = try { $rsobj12->find(1) } || $rsobj12->search({ id => 1 })->first;
isa_ok( try { $obj12->loader_test13 }, $class13 );
+ }
- # relname is preserved when another fk is added
-
- {
- local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /invalidates \d+ active statement/ };
- $conn->storage->disconnect; # for mssql and access
- }
+ # relname is preserved when another fk is added
+ {
+ local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /invalidates \d+ active statement/ };
+ $conn->storage->disconnect; # for mssql and access
+ }
- isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet';
+ isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet';
- $conn->storage->disconnect; # for access
+ $conn->storage->disconnect; # for access
- if (lc($self->{vendor}) ne 'sybase') {
- $conn->storage->dbh->do('ALTER TABLE loader_test4 ADD fkid2 INTEGER REFERENCES loader_test3 (id)');
- }
- else {
- $conn->storage->dbh->do(<<"EOF");
- ALTER TABLE loader_test4 ADD fkid2 INTEGER $self->{null}
- ALTER TABLE loader_test4 ADD CONSTRAINT loader_test4_to_3_fk FOREIGN KEY (fkid2) REFERENCES loader_test3 (id)
+ if (lc($self->{vendor}) !~ /^(?:sybase|mysql)\z/) {
+ $conn->storage->dbh->do('ALTER TABLE loader_test4 ADD fkid2 INTEGER REFERENCES loader_test3 (id)');
+ }
+ else {
+ $conn->storage->dbh->do(<<"EOF");
+ ALTER TABLE loader_test4 ADD fkid2 INTEGER $self->{null}
EOF
- }
+ $conn->storage->dbh->do(<<"EOF");
+ ALTER TABLE loader_test4 ADD CONSTRAINT loader_test4_to_3_fk FOREIGN KEY (fkid2) REFERENCES loader_test3 (id)
+EOF
+ }
- $conn->storage->disconnect; # for firebird
+ $conn->storage->disconnect; # for firebird
- $self->rescan_without_warnings($conn);
+ $self->rescan_without_warnings($conn);
- isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet',
- 'relationship name preserved when another foreign key is added in remote table';
- }
+ isa_ok try { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet',
+ 'relationship name preserved when another foreign key is added in remote table';
SKIP: {
skip 'This vendor cannot do out-of-line implicit rel defs', 4
$digest->addfile($fh);
};
- find $find_cb, $DUMP_DIR;
+ find $find_cb, DUMP_DIR;
-# system "rm -f /tmp/before_rescan/* /tmp/after_rescan/*";
-# system "cp $tdir/common_dump/DBIXCSL_Test/Schema/*.pm /tmp/before_rescan";
+# system "rm -rf /tmp/before_rescan /tmp/after_rescan";
+# system "mkdir /tmp/before_rescan";
+# system "mkdir /tmp/after_rescan";
+# system "cp -a @{[DUMP_DIR]} /tmp/before_rescan";
my $before_digest = $digest->b64digest;
is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan");
-# system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/after_rescan";
+# system "cp -a @{[DUMP_DIR]} /tmp/after_rescan";
$digest = Digest::MD5->new;
- find $find_cb, $DUMP_DIR;
+ find $find_cb, DUMP_DIR;
my $after_digest = $digest->b64digest;
is $before_digest, $after_digest,
$table_name = $$table_name if ref $table_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) uppercase everything
$monikers->{lc $table_name} = $source_name;
- $classes->{lc $table_name} = $schema_class . q{::} . $source_name;
+ $classes->{lc $table_name} = $result_class;
}
return ($monikers, $classes);
q{ INSERT INTO loader_test1s (dat) VALUES('baz') },
# also test method collision
+ # crumb_crisp_coating is for col_accessor_map tests
qq{
CREATE TABLE loader_test2 (
id $self->{auto_inc_pk},
meta INTEGER $self->{null},
test_role_method INTEGER $self->{null},
test_role_for_map_method INTEGER $self->{null},
+ crumb_crisp_coating VARCHAR(32) $self->{null},
UNIQUE (dat2, dat)
) $self->{innodb}
},
c_char_as_data VARCHAR(100)
) $self->{innodb}
},
+ qq{
+ CREATE TABLE loader_test50 (
+ id INTEGER NOT NULL UNIQUE,
+ id1 INTEGER NOT NULL,
+ id2 INTEGER NOT NULL,
+ @{[ $self->{vendor} !~ /^(?:DB2|SQLAnywhere)\z/i ? "
+ id3 INTEGER $self->{null},
+ id4 INTEGER NOT NULL,
+ UNIQUE (id3, id4),
+ " : '' ]}
+ UNIQUE (id1, id2)
+ ) $self->{innodb}
+ },
);
# some DBs require mixed case identifiers to be quoted
id INTEGER NOT NULL PRIMARY KEY,
fkid INTEGER NOT NULL,
dat VARCHAR(32),
- crumb_crisp_coating VARCHAR(32) $self->{null},
belongs_to INTEGER $self->{null},
set_primary_key INTEGER $self->{null},
FOREIGN KEY( fkid ) REFERENCES loader_test3 (id),
$dbh->do($_) foreach (@{ $self->{data_type_tests}{ddl} || [] });
}
- unless($self->{skip_rels}) {
+ unless ($self->{skip_rels}) {
# hack for now, since DB2 doesn't like inline comments, and we need
# to test one for mysql, which works on everyone else...
# this all needs to be refactored anyways.
LoAdEr_test24
loader_test35
loader_test36
+ loader_test50
/;
my @tables_auto_inc = (
my $drop_auto_inc = $self->{auto_inc_drop_cb} || sub {};
- unless($self->{skip_rels}) {
+ unless ($self->{skip_rels}) {
# drop the circular rel columns if possible, this
# doesn't work on all DBs
foreach my $table (keys %drop_columns) {
my @size = split /,/, $size;
# some DBs don't like very long column names
- if ($self->{vendor} =~ /^(?:firebird|sqlanywhere|oracle|db2)\z/i) {
+ if ($self->{vendor} =~ /^(?:firebird|sqlanywhere|oracle|db2|mysql)\z/i) {
my ($col_def, $default) = $type_alias =~ /^(.*)(default.*)?\z/i;
$type_alias = substr $col_def, 0, 15;
my $self = shift;
unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
$self->drop_tables if $self->{_created};
- rmtree $DUMP_DIR
+ rmtree DUMP_DIR
}
}
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff