Revision history for Perl extension DBIx::Class::Schema::Loader
+ - Preserve relationship names when redumping and another FK is added
+ (RT#62424)
+ - Remove resultset_components as ResultSetManager is deprecated
- Fix a fail when very old Moose/CMOP is installed
- Added warning for column-accessor collisions, doc section in ::Base
("COLUMN ACCESSOR COLLISIONS") and the col_collision_map option.
additional_base_classes
left_base_classes
components
- resultset_components
skip_relationships
skip_load_external
moniker_map
pod_comment_spillover_length
preserve_case
col_collision_map
+ real_dump_directory
/);
=head1 NAME
classes. A good example would be
L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
-=head2 resultset_components
-
-List of additional ResultSet components to be loaded into your table
-classes. A good example would be C<AlwaysRS>. Component
-C<ResultSetManager> will be automatically added to the above
-C<components> list if this option is set.
-
=head2 use_namespaces
This is now the default, to go back to L<DBIx::Class::Schema/load_classes> pass
=head2 dump_directory
-This option is designed to be a tool to help you transition from this
-loader to a manually-defined schema when you decide it's time to do so.
-
The value of this option is a perl libdir pathname. Within
that directory this module will create a baseline manual
-L<DBIx::Class::Schema> module set, based on what it creates at runtime
-in memory.
+L<DBIx::Class::Schema> module set, based on what it creates at runtime.
The created schema class will have the same classname as the one on
which you are setting this option (and the ResultSource classes will be
my @CLASS_ARGS = qw(
schema_base_class result_base_class additional_base_classes
- left_base_classes additional_classes components resultset_components
+ left_base_classes additional_classes components
);
# ensure that a peice of object data is a valid arrayref, creating
additional_base_classes
left_base_classes
components
- resultset_components
/);
$self->_validate_class_args;
}
}
- push(@{$self->{components}}, 'ResultSetManager')
- if @{$self->{resultset_components}};
-
$self->{monikers} = {};
$self->{classes} = {};
$self->{_upgrading_classes} = {};
$self->{dump_directory} ||= $self->{temp_directory};
+ $self->real_dump_directory($self->{dump_directory});
+
$self->version_to_dump($DBIx::Class::Schema::Loader::VERSION);
$self->schema_version_to_dump($DBIx::Class::Schema::Loader::VERSION);
my $fullpath = File::Spec->catfile($prefix, $file);
return $fullpath if -f $fullpath
# abs_path throws on Windows for nonexistant files
- and eval { Cwd::abs_path($fullpath) } ne
- (eval { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) } || '');
+ and (try { Cwd::abs_path($fullpath) }) ne
+ ((try { Cwd::abs_path(File::Spec->catfile($self->dump_directory, $file)) }) || '');
}
return;
local $self->{dump_directory} = $self->{temp_directory};
$self->_reload_classes(\@tables);
$self->_load_relationships($_) for @tables;
+ $self->_relbuilder->cleanup;
$self->{quiet} = 0;
# Remove that temp dir from INC so it doesn't get reloaded
# Reload without unloading first to preserve any symbols from external
# packages.
- $self->_reload_classes(\@tables, 0);
+ $self->_reload_classes(\@tables, { unload => 0 });
# Drop temporary cache
delete $self->{_cache};
}
sub _reload_classes {
- my ($self, $tables, $unload) = @_;
+ my ($self, $tables, $opts) = @_;
my @tables = @$tables;
+
+ my $unload = $opts->{unload};
$unload = 1 unless defined $unload;
# so that we don't repeat custom sections
delete $INC{ $class_path };
# kill redefined warnings
- eval {
+ try {
eval_without_redefine_warnings ("require $class");
+ }
+ catch {
+ die "Failed to reload class $class: $_";
};
- die "Failed to reload class $class: $@" if $@;
}
sub _get_dump_filename {
return $self->dump_directory . q{/} . $class . q{.pm};
}
+=head2 get_dump_filename
+
+Arguments: class
+
+Returns the full path to the file for a class that the class has been or will
+be dumped to. This is a file in a temp dir for a dynamic schema.
+
+=cut
+
+sub get_dump_filename {
+ my ($self, $class) = (@_);
+
+ local $self->{dump_directory} = $self->real_dump_directory;
+
+ return $self->_get_dump_filename($class);
+}
+
sub _ensure_dump_subdirs {
my ($self, $class) = (@_);
my $schema_text =
qq|package $schema_class;\n\n|
. qq|# Created by DBIx::Class::Schema::Loader\n|
- . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|
- . qq|use strict;\nuse warnings;\n\n|;
+ . qq|# DO NOT MODIFY THE FIRST PART OF THIS FILE\n\n|;
+
if ($self->use_moose) {
$schema_text.= qq|use Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends '$schema_base_class';\n\n|;
}
else {
- $schema_text .= qq|use base '$schema_base_class';\n\n|;
+ $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
}
if ($self->use_namespaces) {
$self->_dbic_stmt($table_class, 'load_components', @components);
}
- $self->_dbic_stmt($table_class, 'load_resultset_components', @{$self->resultset_components})
- if @{$self->resultset_components};
$self->_inject($table_class, @{$self->additional_base_classes});
}
sub _unregister_source_for_table {
my ($self, $table) = @_;
- eval {
+ try {
local $@;
my $schema = $self->schema;
# in older DBIC it's a private method
use strict;
use warnings;
+use base 'Class::Accessor::Grouped';
use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
-use Scalar::Util ();
-
+use Scalar::Util 'weaken';
use Lingua::EN::Inflect::Phrase ();
use DBIx::Class::Schema::Loader::Utils 'split_name';
+use File::Slurp 'slurp';
+use Try::Tiny;
+use Class::Unload ();
+use List::MoreUtils 'apply';
+use namespace::clean;
our $VERSION = '0.07002';
=cut
+__PACKAGE__->mk_group_accessors('simple', qw/
+ base
+ schema
+ inflect_plural
+ inflect_singular
+ relationship_attrs
+ _temp_classes
+/);
sub new {
my ( $class, $base ) = @_;
inflect_plural => $base->inflect_plural,
inflect_singular => $base->inflect_singular,
relationship_attrs => $base->relationship_attrs,
+ _temp_classes => [],
};
- Scalar::Util::weaken $self->{base}; #< don't leak
+ weaken $self->{base}; #< don't leak
+
+ bless $self => $class;
# validate the relationship_attrs arg
- if( defined $self->{relationship_attrs} ) {
- ref $self->{relationship_attrs} eq 'HASH'
+ if( defined $self->relationship_attrs ) {
+ ref $self->relationship_attrs eq 'HASH'
or croak "relationship_attrs must be a hashref";
}
- return bless $self => $class;
+ return $self;
}
return '' if !defined $relname || $relname eq '';
- if( ref $self->{inflect_plural} eq 'HASH' ) {
- return $self->{inflect_plural}->{$relname}
- if exists $self->{inflect_plural}->{$relname};
+ if( ref $self->inflect_plural eq 'HASH' ) {
+ return $self->inflect_plural->{$relname}
+ if exists $self->inflect_plural->{$relname};
}
- elsif( ref $self->{inflect_plural} eq 'CODE' ) {
- my $inflected = $self->{inflect_plural}->($relname);
+ elsif( ref $self->inflect_plural eq 'CODE' ) {
+ my $inflected = $self->inflect_plural->($relname);
return $inflected if $inflected;
}
return '' if !defined $relname || $relname eq '';
- if( ref $self->{inflect_singular} eq 'HASH' ) {
- return $self->{inflect_singular}->{$relname}
- if exists $self->{inflect_singular}->{$relname};
+ if( ref $self->inflect_singular eq 'HASH' ) {
+ return $self->inflect_singular->{$relname}
+ if exists $self->inflect_singular->{$relname};
}
- elsif( ref $self->{inflect_singular} eq 'CODE' ) {
- my $inflected = $self->{inflect_singular}->($relname);
+ elsif( ref $self->inflect_singular eq 'CODE' ) {
+ my $inflected = $self->inflect_singular->($relname);
return $inflected if $inflected;
}
# either a hashref (if some options are set), or nothing
sub _relationship_attrs {
my ( $self, $reltype ) = @_;
- my $r = $self->{relationship_attrs};
+ my $r = $self->relationship_attrs;
my %composite = (
%{ $self->_default_relationship_attrs->{$reltype} || {} },
# If the referring column is nullable, make 'belongs_to' an
# outer join, unless explicitly set by relationship_attrs
- my $nullable = grep { $self->{schema}->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
+ my $nullable = grep { $self->schema->source($local_moniker)->column_info($_)->{is_nullable} } @$local_cols;
$attrs->{join_type} = 'LEFT' if $nullable && !defined $attrs->{join_type};
return $attrs;
my $all_code = {};
- my $local_class = $self->{schema}->class($local_moniker);
+ my $local_class = $self->schema->class($local_moniker);
my %counters;
foreach my $rel (@$rels) {
my $remote_moniker = $rel->{remote_source}
or next;
- my $remote_class = $self->{schema}->class($remote_moniker);
- my $remote_obj = $self->{schema}->source($remote_moniker);
+ my $remote_class = $self->schema->class($remote_moniker);
+ my $remote_obj = $self->schema->source($remote_moniker);
my $remote_cols = $rel->{remote_columns} || [ $remote_obj->primary_columns ];
my $local_cols = $rel->{local_columns};
my ( $self, $local_moniker, $rel, $cond, $uniqs, $counters ) = @_;
my $remote_moniker = $rel->{remote_source};
- my $remote_obj = $self->{schema}->source( $remote_moniker );
- my $remote_class = $self->{schema}->class( $remote_moniker );
+ my $remote_obj = $self->schema->source( $remote_moniker );
+ my $remote_class = $self->schema->class( $remote_moniker );
my $remote_relname = $self->_remote_relname( $remote_obj->from, $cond);
- my $local_cols = $rel->{local_columns};
- my $local_table = $self->{schema}->source($local_moniker)->from;
+ my $local_cols = $rel->{local_columns};
+ my $local_table = $self->schema->source($local_moniker)->from;
+ my $local_class = $self->schema->class($local_moniker);
+ my $local_source = $self->schema->source($local_moniker);
- # If more than one rel between this pair of tables, use the local
- # col names to distinguish
- my ($local_relname, $local_relname_uninflected);
- if ( $counters->{$remote_moniker} > 1) {
- my $colnames = q{_} . $self->_normalize_name(join '_', @$local_cols);
- $remote_relname .= $colnames if keys %$cond > 1;
-
- $local_relname = $self->_normalize_name($local_table . $colnames);
- $local_relname =~ s/_id$//;
-
- $local_relname_uninflected = $local_relname;
- $local_relname = $self->_inflect_plural($local_relname);
- } else {
- $local_relname_uninflected = $self->_normalize_name($local_table);
- $local_relname = $self->_inflect_plural($self->_normalize_name($local_table));
- }
+ my $local_relname_uninflected = $self->_normalize_name($local_table);
+ my $local_relname = $self->_inflect_plural($self->_normalize_name($local_table));
my $remote_method = 'has_many';
# If the local columns have a UNIQUE constraint, this is a one-to-one rel
- my $local_source = $self->{schema}->source($local_moniker);
if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) ||
grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) {
$remote_method = 'might_have';
$local_relname = $self->_inflect_singular($local_relname_uninflected);
}
+ # If more than one rel between this pair of tables, use the local
+ # col names to distinguish, unless the rel was created previously.
+ if ($counters->{$remote_moniker} > 1) {
+ my $relationship_exists = 0;
+
+ if (-f (my $existing_remote_file = $self->{base}->get_dump_filename($remote_class))) {
+ my $class = "${remote_class}Temporary";
+
+ if (not do { no strict 'refs'; %{$class . '::'} }) {
+ my $code = slurp $existing_remote_file;
+
+ $code =~ s/(?<=package $remote_class)/Temporary/g;
+
+ $code =~ s/__PACKAGE__->meta->make_immutable;//g;
+
+ eval $code;
+ die $@ if $@;
+
+ push @{ $self->_temp_classes }, $class;
+ }
+
+ if ($class->has_relationship($local_relname)) {
+ my $rel_cols = [ sort { $a cmp $b } apply { s/^foreign\.//i }
+ (keys %{ $class->relationship_info($local_relname)->{cond} }) ];
+
+ $relationship_exists = 1 if $self->_array_eq([ sort @$local_cols ], $rel_cols);
+ }
+ }
+
+ if (not $relationship_exists) {
+ my $colnames = q{_} . $self->_normalize_name(join '_', @$local_cols);
+ $remote_relname .= $colnames if keys %$cond > 1;
+
+ $local_relname = $self->_normalize_name($local_table . $colnames);
+ $local_relname =~ s/_id$//;
+
+ $local_relname_uninflected = $local_relname;
+ $local_relname = $self->_inflect_plural($local_relname);
+
+ # if colnames were added and this is a might_have, re-inflect
+ if ($remote_method eq 'might_have') {
+ $local_relname = $self->_inflect_singular($local_relname_uninflected);
+ }
+ }
+ }
+
return ( $local_relname, $remote_relname, $remote_method );
}
+sub cleanup {
+ my $self = shift;
+
+ for my $class (@{ $self->_temp_classes }) {
+ Class::Unload->unload($class);
+ }
+
+ $self->_temp_classes([]);
+}
+
=head1 AUTHOR
See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
use strict;
use warnings;
use Data::Dumper ();
+use Test::More;
+use namespace::clean;
use Exporter 'import';
-our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_without_redefine_warnings/;
+our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_without_redefine_warnings warnings_exist warnings_exist_silent/;
use constant BY_CASE_TRANSITION =>
qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/;
die $@ if $@;
}
+sub warnings_exist(&$$) {
+ my ($code, $re, $test_name) = @_;
+
+ my $matched = 0;
+
+ my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+ local $SIG{__WARN__} = sub {
+ if ($_[0] =~ $re) {
+ $matched = 1;
+ }
+ else {
+ $warn_handler->(@_)
+ }
+ };
+
+ $code->();
+
+ ok $matched, $test_name;
+}
+
+sub warnings_exist_silent(&$$) {
+ my ($code, $re, $test_name) = @_;
+
+ my $matched = 0;
+
+ local $SIG{__WARN__} = sub { $matched = 1 if $_[0] =~ $re; };
+
+ $code->();
+
+ ok $matched, $test_name;
+}
+
+
1;
# vim:et sts=4 sw=4 tw=0:
'qualified sequence detected';
my $class = $classes->{pg_loader_test1};
- my $filename = $schema->_loader->_get_dump_filename($class);
+ my $filename = $schema->_loader->get_dump_filename($class);
my $code = slurp $filename;
'column comment and attrs';
$class = $classes->{pg_loader_test2};
- $filename = $schema->_loader->_get_dump_filename($class);
+ $filename = $schema->_loader->get_dump_filename($class);
$code = slurp $filename;
SKIP: {
skip 'not running comment tests', 1 unless (my $class = $classes->{oracle_loader_test1});
- my $filename = $schema->_loader->_get_dump_filename($class);
+ my $filename = $schema->_loader->get_dump_filename($class);
my $code = File::Slurp::slurp $filename;
like $code, qr/^=head1 NAME\n\n^$class - oracle_loader_test1 table comment\n\n^=cut\n/m,
use warnings;
use Test::More;
use Test::Exception;
-use Test::Warn;
+use DBIx::Class::Schema::Loader::Utils 'warnings_exist_silent';
+use namespace::clean;
# use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else
BEGIN {
my $dbh = $schema->storage->dbh;
$dbh->do("DROP TABLE mssql_loader_test3");
- warnings_exist { $schema->rescan }
+ warnings_exist_silent { $schema->rescan }
qr/^Bad table or view 'mssql_loader_test4'/, 'bad view ignored';
throws_ok {
count => 6,
run => sub {
$schema = shift;
+ my ($monikers, $classes, $self) = @_;
cleanup_extra();
local $schema->_loader->{preserve_case} = 1;
$schema->_loader->_setup;
- {
- # FIXME - need to remove blind trap (can not test firebird yet)
- local $SIG{__WARN__} = sub {};
- $schema->rescan;
- }
+ $self->rescan_without_warnings($schema);
ok ((my $rsrc = eval { $schema->resultset('FirebirdLoaderTest1')->result_source }),
'got rsrc for mixed case table');
my $res = run_loader(static => 1, naming => 'current');
my $schema = $res->{schema};
- my $file = $schema->_loader->_get_dump_filename($SCHEMA_CLASS);
+ my $file = $schema->_loader->get_dump_filename($SCHEMA_CLASS);
my $code = slurp $file;
my ($dumped_ver) =
sub class_content_like {
my ($schema, $class, $re, $test_name) = @_;
- my $file = $schema->_loader->_get_dump_filename($class);
+ my $file = $schema->_loader->get_dump_filename($class);
my $code = slurp $file;
like $code, $re, $test_name;
sub _write_custom_content {
my ($schema, $class, $content) = @_;
- my $pm = $schema->_loader->_get_dump_filename($class);
+ my $pm = $schema->_loader->get_dump_filename($class);
{
local ($^I, @ARGV) = ('.bak', $pm);
while (<>) {
+++ /dev/null
-package DBIx::Class::TestRSComponent;
-use base qw/DBIx::Class::ResultSet/;
-
-sub dbix_class_testrscomponent { 'dbix_class_testrscomponent works' }
-
-1;
sub run_tests {
my $self = shift;
- plan tests => 101;
+ plan tests => 98;
$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;
{
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' );
- #}
}
+++ /dev/null
-package DBIx::Class::TestRSComponent;
-use base qw/DBIx::Class::ResultSet/;
-
-sub dbix_class_testrscomponent { 'dbix_class_testrscomponent works' }
-
-1;
my $DUMP_DIR = "$tdir/common_dump";
rmtree $DUMP_DIR;
+use constant RESCAN_WARNINGS => qr/(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement|^Bad table or view/;
+
sub new {
my $class = shift;
my $extra_count = $self->{extra}{count} || 0;
- plan tests => @connect_info * (185 + $extra_count + ($self->{data_type_tests}{test_count} || 0));
+ plan tests => @connect_info * (181 + $extra_count + ($self->{data_type_tests}{test_count} || 0));
foreach my $info_idx (0..$#connect_info) {
my $info = $connect_info[$info_idx];
my $conn = $schema_class->clone;
$self->test_data_types($conn);
- $self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run};
+ $self->{extra}{run}->($conn, $monikers, $classes, $self) if $self->{extra}{run};
if (not ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#$connect_info)) {
$self->drop_extra_tables_only;
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,
is $file_count, $expected_count, 'correct number of files generated';
my $warn_count = 2;
- $warn_count++ if grep /ResultSetManager/, @loader_warnings;
$warn_count++ for grep /^Bad table or view/, @loader_warnings;
}
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: {
can_ok( $class1, 'loader_test1_classmeth' )
or skip "Pre-requisite test failed", 1;
is( $class1->loader_test1_classmeth, 'all is well', 'Class method' );
}
- 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_increment detection' );
my $obj = $rsobj1->find(1);
# relname is preserved when another fk is added
- isa_ok $rsobj3->find(1)->loader_test4zes, 'DBIx::Class::ResultSet';
+ skip 'Sybase cannot add FKs via ALTER TABLE', 2
+ if $self->{vendor} eq 'sybase';
- $conn->storage->dbh->do('ALTER TABLE loader_test4 ADD COLUMN fkid2 INTEGER REFERENCES loader_test3 (id)');
{
- local $SIG{__WARN__} = sub { warn @_
- unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement/
- };
- $conn->rescan;
+ local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /invalidates \d+ active statement/ };
+ $conn->storage->disconnect; # for mssql
}
+ isa_ok $rsobj3->find(1)->loader_test4zes, 'DBIx::Class::ResultSet';
+
+ $conn->storage->dbh->do('ALTER TABLE loader_test4 ADD fkid2 INTEGER REFERENCES loader_test3 (id)');
+
+ $conn->storage->disconnect; # for firebird
+
+ $self->rescan_without_warnings($conn);
+
isa_ok eval { $rsobj3->find(1)->loader_test4zes }, 'DBIx::Class::ResultSet',
'relationship name preserved when another foreign key is added in remote table';
}
sleep 1;
- my @new = do {
- local $SIG{__WARN__} = sub { warn @_
- unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method/
- };
- $conn->rescan;
- };
+ my @new = $self->rescan_without_warnings($conn);
+
is_deeply(\@new, [ qw/LoaderTest30/ ], "Rescan");
# system "cp t/_common_dump/DBIXCSL_Test/Schema/*.pm /tmp/after_rescan";
$conn->storage->disconnect; # for Firebird
$conn->storage->dbh->do("DROP TABLE loader_test30");
- @new = do {
- local $SIG{__WARN__} = sub { warn @_
- unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method/
- };
- $conn->rescan;
- };
+ @new = $self->rescan_without_warnings($conn);
+
is_deeply(\@new, [], 'no new tables on rescan');
throws_ok { $conn->resultset('LoaderTest30') }
$self->test_data_types($conn);
# run extra tests
- $self->{extra}{run}->($conn, $monikers, $classes) if $self->{extra}{run};
+ $self->{extra}{run}->($conn, $monikers, $classes, $self) if $self->{extra}{run};
$self->test_preserve_case($conn);
$conn->_loader->_setup;
- {
- local $SIG{__WARN__} = sub { warn @_
- unless $_[0] =~ /(?i:loader_test)\d+ has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method/
- };
- $conn->rescan;
- };
+ $self->rescan_without_warnings($conn);
if (not $self->{skip_rels}) {
is $conn->resultset('LoaderTest41')->find(1)->loader_test40->foo3_bar, 'foo',
return $test_count;
}
+sub rescan_without_warnings {
+ my ($self, $conn) = @_;
+
+ local $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ RESCAN_WARNINGS };
+ return $conn->rescan;
+}
+
sub DESTROY {
my $self = shift;
unless ($ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) {
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff