Revision history for Perl extension DBIx::Class::Schema::Loader
+ - fix a bug in dynamic schema_base_class/schema_components
+ implementation that ran the connection method twice on subsequent
+ connects
- use a temp file for filter_generated_code with a string program name
instead of IPC::Open2, which hangs on Win32 (RT#72226)
- previous version referred to the wrong RT# for the uniq_to_primary
use Carp::Clan qw/^DBIx::Class/;
use Scalar::Util 'weaken';
use Sub::Name 'subname';
+use DBIx::Class::Schema::Loader::Utils 'array_eq';
use namespace::clean;
# Always remember to do all digits for the version even if they're 0
use_namespaces => 1,
);
+ my $modify_isa = 0;
+ my @components;
+
if ($temp_loader->schema_base_class || $temp_loader->schema_components) {
- my @components = @{ $temp_loader->schema_components }
+ @components = @{ $temp_loader->schema_components }
if $temp_loader->schema_components;
push @components, ('+'.$temp_loader->schema_base_class)
if $temp_loader->schema_base_class;
+ my $class_isa = do {
+ no strict 'refs';
+ \@{"${class}::ISA"};
+ };
+
+ my @component_classes = map {
+ /^\+/ ? substr($_, 1, length($_) - 1) : "DBIx::Class::$_"
+ } @components;
+
+ $modify_isa++ if not array_eq([ @$class_isa[0..(@components-1)] ], \@component_classes)
+ }
+
+ if ($modify_isa) {
$class->load_components(@components);
# This hack is necessary because we changed @ISA of $self through
use mro 'c3';
use Carp::Clan qw/^DBIx::Class/;
use Scalar::Util 'weaken';
-use DBIx::Class::Schema::Loader::Utils qw/split_name slurp_file/;
+use DBIx::Class::Schema::Loader::Utils qw/split_name slurp_file array_eq/;
use Try::Tiny;
use List::MoreUtils qw/apply uniq any/;
use namespace::clean;
return $name;
}
-sub _array_eq {
- my ($self, $a, $b) = @_;
-
- return unless @$a == @$b;
-
- for (my $i = 0; $i < @$a; $i++) {
- return unless $a->[$i] eq $b->[$i];
- }
- return 1;
-}
-
sub _remote_attrs {
my ($self, $local_moniker, $local_cols) = @_;
my $remote_method = 'has_many';
# If the local columns have a UNIQUE constraint, this is a one-to-one rel
- if ($self->_array_eq([ $local_source->primary_columns ], $local_cols) ||
- grep { $self->_array_eq($_->[1], $local_cols) } @$uniqs) {
+ if (array_eq([ $local_source->primary_columns ], $local_cols) ||
+ grep { array_eq($_->[1], $local_cols) } @$uniqs) {
$remote_method = 'might_have';
($local_relname) = $self->_inflect_singular($local_relname_uninflected);
}
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);
+ $relationship_exists = 1 if array_eq([ sort @$local_cols ], $rel_cols);
}
}
use warnings;
use base 'DBIx::Class::Schema::Loader::RelBuilder::Compat::v0_06';
use mro 'c3';
+use DBIx::Class::Schema::Loader::Utils 'array_eq';
+use namespace::clean;
use Lingua::EN::Inflect::Number ();
our $VERSION = '0.07011';
# 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) {
+ if (array_eq([ $local_source->primary_columns ], $local_cols) ||
+ grep { array_eq($_->[1], $local_cols) } @$uniqs) {
$remote_method = 'might_have';
($local_relname) = $self->_inflect_singular($local_relname_uninflected);
}
use Test::More;
use String::CamelCase 'wordsplit';
use Carp::Clan qw/^DBIx::Class/;
+use Scalar::Util 'looks_like_number';
use namespace::clean;
use Exporter 'import';
use Data::Dumper ();
-our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path no_warnings warnings_exist warnings_exist_silent slurp_file write_file/;
+our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path no_warnings warnings_exist warnings_exist_silent slurp_file write_file array_eq/;
use constant BY_CASE_TRANSITION_V7 =>
qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/;
close $fh;
}
+sub array_eq($$) {
+ no warnings 'uninitialized';
+ my ($a, $b) = @_;
+
+ return unless @$a == @$b;
+
+ for (my $i = 0; $i < @$a; $i++) {
+ if (looks_like_number $a->[$i]) {
+ return unless $a->[$i] == $b->[$i];
+ }
+ else {
+ return unless $a->[$i] eq $b->[$i];
+ }
+ }
+ return 1;
+}
+
1;
# vim:et sts=4 sw=4 tw=0:
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 10;
use DBIx::Class::Schema::Loader 'make_schema_at';
use lib 't/lib';
use make_dbictest_db;
[ $make_dbictest_db::dsn ],
);
-ok $TestSchemaBaseClass::test_ok,
+is $TestSchemaBaseClass::test_ok, 1,
'connected using schema_base_class';
-ok $DBIx::Class::TestSchemaComponent::test_component_ok,
+is $DBIx::Class::TestSchemaComponent::test_component_ok, 1,
'connected using schema_components';
# try an explicit dynamic schema
-$TestSchemaBaseClass::test_ok = 0;
-$DBIx::Class::TestSchemaComponent::test_component_ok = 0;
-
{
package DBICTest::Schema::_test_schema_base_dynamic;
use base 'DBIx::Class::Schema::Loader';
+ our $ran_connection = 0;
__PACKAGE__->loader_options({
naming => 'current',
schema_base_class => 'TestSchemaBaseClass',
schema_components => ['TestSchemaComponent'],
});
# check that connection doesn't cause an infinite loop
- sub connection { my $self = shift; return $self->next::method(@_) }
+ sub connection { my $self = shift; $ran_connection++; return $self->next::method(@_) }
}
+$TestSchemaBaseClass::test_ok = 0;
+$DBIx::Class::TestSchemaComponent::test_component_ok = 0;
+
ok(my $schema =
DBICTest::Schema::_test_schema_base_dynamic->connect($make_dbictest_db::dsn),
'connected dynamic schema');
-ok $TestSchemaBaseClass::test_ok,
+is $DBICTest::Schema::_test_schema_base_dynamic::ran_connection, 1,
+ 'schema class connection method ran only once';
+
+is $TestSchemaBaseClass::test_ok, 1,
'connected using schema_base_class in dynamic schema';
-ok $DBIx::Class::TestSchemaComponent::test_component_ok,
+is $DBIx::Class::TestSchemaComponent::test_component_ok, 1,
'connected using schema_components in dynamic schema';
# connect a second time
$TestSchemaBaseClass::test_ok = 0;
$DBIx::Class::TestSchemaComponent::test_component_ok = 0;
+$DBICTest::Schema::_test_schema_base_dynamic::ran_connection = 0;
ok($schema =
DBICTest::Schema::_test_schema_base_dynamic->connect($make_dbictest_db::dsn),
'connected dynamic schema a second time');
-ok $TestSchemaBaseClass::test_ok,
+is $DBICTest::Schema::_test_schema_base_dynamic::ran_connection, 1,
+'schema class connection method ran only once when connecting a second time';
+
+is $TestSchemaBaseClass::test_ok, 1,
'connected using schema_base_class in dynamic schema a second time';
-ok $DBIx::Class::TestSchemaComponent::test_component_ok,
+is $DBIx::Class::TestSchemaComponent::test_component_ok, 1,
'connected using schema_components in dynamic schema a second time';
sub connection {
my ($self, @info) = @_;
- $test_component_ok = 1;
+ $test_component_ok++;
return $self->next::method(@info);
}
my ($self, @info) = @_;
if ($info[0] =~ /^dbi/) {
- $test_ok = 1;
+ $test_ok++;
}
return $self->next::method(@info);
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff