This is a necessary part of the rsrc refactor, which there is no way around.
And yes - it is extremely invasive and dangerous, with very high chance of
fallout. Given the situation there is no other way :/
The implementation itself is rather simple: all we need to do is hook
inject_base (which is called by load_components via several levels of
indirection), and also (as a precaution) we set the mro on anything loaded
via a component-group accessor. This seems to nicely cover pretty much all
of the hierarchy (except ::Storage, but that is another matter/rewrite)
Also move the CAG compat pieces where they belong
Revision history for DBIx::Class
* Notable Changes and Deprecations
+ - The entire class hierarchy now explicitly sets the 'c3' mro, even
+ in cases where load_components was not used. Extensive testing led
+ the maintainer believe this is safe, but this is a very complex
+ area and reality may turn out to be different. If **ANYHTING** at
+ all seems out of place, please file a report at once
- Neither exception_action() nor $SIG{__DIE__} handlers are invoked
on recoverable errors. This ensures that the retry logic is fully
insulated from changes in control flow, as the handlers are only
sub DESTROY { &DBIx::Class::_Util::detected_reinvoked_destructor };
}
-sub mk_classdata {
- shift->mk_classaccessor(@_);
-}
+sub component_base_class { 'DBIx::Class' }
-sub mk_classaccessor {
- my $self = shift;
- $self->mk_group_accessors('inherited', $_[0]);
- $self->set_inherited(@_) if @_ > 1;
-}
+my $mro_already_set;
+sub inject_base {
-sub component_base_class { 'DBIx::Class' }
+ # only examine from $_[2] onwards
+ # C::C3::C already sets c3 on $_[1] and $_[0] is irrelevant
+ mro::set_mro( $_ => 'c3' ) for grep {
+ $mro_already_set->{$_} ? 0 : ( $mro_already_set->{$_} = 1 )
+ } @_[2 .. $#_];
+
+ shift->next::method(@_);
+}
sub MODIFY_CODE_ATTRIBUTES {
my ($class,$code,@attrs) = @_;
use Scalar::Util qw/weaken blessed/;
use namespace::clean;
+sub mk_classdata {
+ shift->mk_classaccessor(@_);
+}
+
+sub mk_classaccessor {
+ my $self = shift;
+ $self->mk_group_accessors('inherited', $_[0]);
+ $self->set_inherited(@_) if @_ > 1;
+}
+
my $successfully_loaded_components;
sub get_component_class {
if (defined $class and ! $successfully_loaded_components->{$class} ) {
$_[0]->ensure_class_loaded($class);
+ mro::set_mro( $class, 'c3' );
+
no strict 'refs';
$successfully_loaded_components->{$class}
= ${"${class}::__LOADED__BY__DBIC__CAG__COMPONENT_CLASS__"}
use strict;
use warnings;
-use base qw/DBIx::Class/;
+
+use base 'DBIx::Class';
+use mro 'c3';
+
use DBIx::Class::Carp;
use DBIx::Class::ResultSetColumn;
use DBIx::Class::ResultClass::HashRefInflator;
use strict;
use warnings;
-use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
+use base 'DBIx::Class';
+__PACKAGE__->load_components(qw(
+ ResultSource::RowParser
+));
use DBIx::Class::Carp;
use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try );
use warnings;
use base 'DBIx::Class';
+use mro 'c3';
use Scalar::Util 'blessed';
use DBIx::Class::_Util 'quote_sub';
use warnings;
use base 'DBIx::Class';
+use mro 'c3';
use DBIx::Class::Carp;
use Try::Tiny;
ignore => [qw/
MODIFY_CODE_ATTRIBUTES
component_base_class
+ inject_base
mk_classdata
mk_classaccessor
/]
use strict;
use Test::More;
+use DBICTest;
+
+my @global_ISA_tail = qw(
+ DBIx::Class
+ DBIx::Class::Componentised
+ Class::C3::Componentised
+ DBIx::Class::AccessorGroup
+ Class::Accessor::Grouped
+);
-
-use DBICTest; # do not remove even though it is not used (pulls in MRO::Compat if needed)
+is(
+ mro::get_mro('DBIx::Class'),
+ 'c3',
+ 'Correct mro on base class DBIx::Class',
+);
{
package AAA;
eval { mro::get_linear_isa('CCC'); };
ok (! $@, "Correctly skipped injecting an indirect parent of class BBB");
+
+my $art = DBICTest->init_schema->resultset("Artist")->next;
+
+check_ancestry($_) for (
+ ref( $art ),
+ ref( $art->result_source ),
+ ref( $art->result_source->resultset ),
+ ref( $art->result_source->schema ),
+ qw( AAA BBB CCC ),
+);
+
use DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
is_deeply (
DBIx::Class::Storage::DBI
DBIx::Class::Storage::DBIHacks
DBIx::Class::Storage
- DBIx::Class
- DBIx::Class::Componentised
- Class::C3::Componentised
- DBIx::Class::AccessorGroup
- Class::Accessor::Grouped
- /],
+ /, @global_ISA_tail],
'Correctly ordered ISA of DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server'
);
#ok (! $INC{'MRO/Compat.pm'}, 'No MRO::Compat loaded on perl 5.10+');
}
+sub check_ancestry {
+ my $class = shift;
+
+ die "Expecting classname" if length ref $class;
+
+ my @linear_ISA = @{ mro::get_linear_isa($class) };
+
+ # something is *VERY* wrong, the splice below won't make it
+ unless (@linear_ISA > @global_ISA_tail) {
+ fail(
+ "Unexpectedly shallow \@ISA for class '$class': "
+ . join ', ', map { "'$_'" } @linear_ISA
+ );
+ return;
+ }
+
+ is_deeply (
+ [ splice @linear_ISA, ($#linear_ISA - $#global_ISA_tail) ],
+ \@global_ISA_tail,
+ "Correct end of \@ISA for '$class'"
+ );
+
+ # check the remainder
+ for my $c (@linear_ISA) {
+ # nothing to see there
+ next if $c =~ /^DBICTest::/;
+
+ next if mro::get_mro($c) eq 'c3';
+
+ fail( "Incorrect mro '@{[ mro::get_mro($c) ]}' on '$c' (parent of '$class')" );
+ }
+}
+
done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff