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=fa9b7d9245cbc33f2481a94a0d8247b8cc1d0584;hpb=c0e7b4e55952cd193b6f1866d0c27ece182397eb;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Componentised.pm b/lib/DBIx/Class/Componentised.pm index fa9b7d9..5a59238 100644 --- a/lib/DBIx/Class/Componentised.pm +++ b/lib/DBIx/Class/Componentised.pm @@ -1,44 +1,43 @@ -package # hide from PAUSE +package # hide from PAUSE DBIx::Class::Componentised; -use Class::C3; +use strict; +use warnings; +use base 'Class::C3::Componentised'; +use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/; +use mro 'c3'; + +# this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column sub inject_base { - my ($class, $target, @to_inject) = @_; - { - no strict 'refs'; - unshift(@{"${target}::ISA"}, grep { $target ne $_ && !$target->isa($_)} @to_inject); - } + my $class = shift; + my $target = shift; - # Yes, this is hack. But it *does* work. Please don't submit tickets about - # it on the basis of the comments in Class::C3, the author was on #dbix-class - # while I was implementing this. + my @present_components = (@{mro::get_linear_isa ($target)||[]}); - my $table = { Class::C3::_dump_MRO_table }; - eval "package $target; import Class::C3;" unless exists $table->{$target}; -} + no strict 'refs'; + for my $comp (reverse @_) { -sub load_components { - my $class = shift; - my $base = $class->component_base_class; - my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_; - $class->_load_components(@comp); - Class::C3::reinitialize(); -} + if ($comp->isa ('DBIx::Class::UTF8Columns') ) { + require B; + my @broken; -sub load_own_components { - my $class = shift; - my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_; - $class->_load_components(@comp); -} + for (@present_components) { + my $cref = $_->can ('store_column') + or next; + push @broken, $_ if B::svref_2object($cref)->STASH->NAME ne 'DBIx::Class::Row'; + } -sub _load_components { - my ($class, @comp) = @_; - foreach my $comp (@comp) { - eval "use $comp"; - die $@ if $@; + 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;