X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FComponentised.pm;h=7b6813ef8fef8015e08607e7bd72b93ec9e13d14;hb=e81f0fe2065fb6b30eb27accf7bbf372103e0a26;hp=412958f62e65a5225d5bd99a46f3243b3d46ecd9;hpb=df88a29cfe1085d225c3954b10358c1da8dba7ec;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Componentised.pm b/lib/DBIx/Class/Componentised.pm index 412958f..7b6813e 100644 --- a/lib/DBIx/Class/Componentised.pm +++ b/lib/DBIx/Class/Componentised.pm @@ -4,69 +4,34 @@ package # hide from PAUSE use strict; use warnings; -use Class::C3; -use Class::Inspector; +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'; - foreach my $to (reverse @to_inject) { - my @comps = qw(DigestColumns ResultSetManager Ordered UTF8Columns); - # Add components here that need to be loaded before Core - foreach my $first_comp (@comps) { - if ($to eq 'DBIx::Class::Core' && - $target->isa("DBIx::Class::${first_comp}")) { - warn "Possible incorrect order of components in ". - "${target}::load_components($first_comp) call: Core loaded ". - "before $first_comp. See the documentation for ". - "DBIx::Class::$first_comp for more information"; - } - } - unshift( @{"${target}::ISA"}, $to ) - unless ($target eq $to || $target->isa($to)); - } - } - - # 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 $table = { Class::C3::_dump_MRO_table }; - eval "package $target; import Class::C3;" unless exists $table->{$target}; -} - -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(); -} - -sub load_own_components { my $class = shift; - my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_; - $class->_load_components(@comp); -} - -sub _load_components { - my ($class, @comp) = @_; - foreach my $comp (@comp) { - $class->ensure_class_loaded($comp); + my $target = shift; + + my @present_components = (@{mro::get_linear_isa ($target)||[]}); + + no strict 'refs'; + for my $comp (reverse @_) { + if ( + $comp->isa ('DBIx::Class::UTF8Columns') + and + my @broken = grep { $_ ne 'DBIx::Class::Row' and defined ${"${_}::"}{store_column} } (@present_components) + ) { + 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'; + } + else { + unshift @present_components, $comp; + } } - $class->inject_base($class => @comp); -} -# TODO: handle ->has_many('rel', 'Class'...) instead of -# ->has_many('rel', 'Some::Schema::Class'...) -sub ensure_class_loaded { - my ($class, $f_class) = @_; - eval "require $f_class"; - my $err = $@; - Class::Inspector->loaded($f_class) - or die $err || "require $f_class was successful but the package". - "is not defined"; + $class->next::method($target, @_); } 1;