X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FComponentised.pm;h=5a592388bfbace00d4bc7c9987b4c384f9cfbde4;hb=ef8d02eb7856f32ef1d738aba4923a167c6ed2df;hp=2ee90941a631dc2d6784dcbf4c036eb08dcfb94f;hpb=7411204b288b1df6416832707a8a6ce11e2ab3d8;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Componentised.pm b/lib/DBIx/Class/Componentised.pm index 2ee9094..5a59238 100644 --- a/lib/DBIx/Class/Componentised.pm +++ b/lib/DBIx/Class/Componentised.pm @@ -1,38 +1,43 @@ -package DBIx::Class::Componentised; +package # hide from PAUSE + DBIx::Class::Componentised; -use Class::C3; +use strict; +use warnings; -sub inject_base { - my ($class, $target, @to_inject) = @_; - { - no strict 'refs'; - unshift(@{"${target}::ISA"}, grep { $target ne $_ && !$target->isa($_)} @to_inject); - } - my $table = { Class::C3::_dump_MRO_table }; - eval "package $target; import Class::C3;" unless exists $table->{$target}; - Class::C3::reinitialize() if defined $table->{$target}; -} +use base 'Class::C3::Componentised'; +use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/; +use mro 'c3'; -sub load_components { +# this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column +sub inject_base { my $class = shift; - my $base = $class->component_base_class; - my @comp = map { "${base}::$_" } grep { $_ !~ /^#/ } @_; - $class->_load_components(@comp); -} + my $target = shift; -sub load_own_components { - my $class = shift; - my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_; - $class->_load_components(@comp); -} + my @present_components = (@{mro::get_linear_isa ($target)||[]}); + + no strict 'refs'; + for my $comp (reverse @_) { + + if ($comp->isa ('DBIx::Class::UTF8Columns') ) { + require B; + my @broken; -sub _load_components { - my ($class, @comp) = @_; - foreach my $comp (@comp) { - eval "use $comp"; - die $@ if $@; + for (@present_components) { + my $cref = $_->can ('store_column') + or next; + push @broken, $_ if B::svref_2object($cref)->STASH->NAME ne 'DBIx::Class::Row'; + } + + carp "Incorrect loading order of $comp by ${target} will affect other components overriding store_column (" + . join (', ', @broken) + .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info' + if @broken; + } + + unshift @present_components, $comp; } - $class->inject_base($class => @comp); + + $class->next::method($target, @_); } 1;