Restore ability to handle underdefined root (t/prefetch/incomplete.t)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Componentised.pm
CommitLineData
75d07914 1package # hide from PAUSE
c0e7b4e5 2 DBIx::Class::Componentised;
227d4dee 3
bf5ecff9 4use strict;
5use warnings;
6
48a76fcf 7use base 'Class::C3::Componentised';
d38cd95c 8use mro 'c3';
9
70c28808 10use DBIx::Class::Carp '^DBIx::Class|^Class::C3::Componentised';
3c2a505c 11
d38cd95c 12# this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column
1415f198 13# if and only if it is placed before something overriding store_column
d38cd95c 14sub inject_base {
15 my $class = shift;
1415f198 16 my ($target, @complist) = @_;
d38cd95c 17
1415f198 18 # we already did load the component
05d90040 19 my $keep_checking = ! (
20 $target->isa ('DBIx::Class::UTF8Columns')
21 ||
22 $target->isa ('DBIx::Class::ForceUTF8')
23 );
d38cd95c 24
3c2a505c 25 my @target_isa;
7146f619 26
1415f198 27 while ($keep_checking && @complist) {
28
05d90040 29 @target_isa = do { no strict 'refs'; @{"$target\::ISA"} }
30 unless @target_isa;
31
1415f198 32 my $comp = pop @complist;
7146f619 33
3c2a505c 34 # warn here on use of either component, as we have no access to ForceUTF8,
35 # the author does not respond, and the Catalyst wiki used to recommend it
36 for (qw/DBIx::Class::UTF8Columns DBIx::Class::ForceUTF8/) {
37 if ($comp->isa ($_) ) {
38 $keep_checking = 0; # no use to check from this point on
70c28808 39 carp_once "Use of $_ is strongly discouraged. See documentation of DBIx::Class::UTF8Columns for more info\n"
40 unless $ENV{DBIC_UTF8COLUMNS_OK};
3c2a505c 41 last;
42 }
43 }
72ae8e40 44
3c2a505c 45 # something unset $keep_checking - we got a unicode mangler
46 if (! $keep_checking) {
1415f198 47
3c2a505c 48 my $base_store_column = do { require DBIx::Class::Row; DBIx::Class::Row->can ('store_column') };
05d90040 49
1415f198 50 my @broken;
51 for my $existing_comp (@target_isa) {
52 my $sc = $existing_comp->can ('store_column')
53 or next;
54
55 if ($sc ne $base_store_column) {
56 require B;
57 my $definer = B::svref_2object($sc)->STASH->NAME;
58 push @broken, ($definer eq $existing_comp)
59 ? $existing_comp
60 : "$existing_comp (via $definer)"
61 ;
62 }
7146f619 63 }
64
1415f198 65 carp "Incorrect loading order of $comp by $target will affect other components overriding 'store_column' ("
d38cd95c 66 . join (', ', @broken)
7146f619 67 .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info'
1415f198 68 if @broken;
d38cd95c 69 }
7146f619 70
1415f198 71 unshift @target_isa, $comp;
d38cd95c 72 }
73
1415f198 74 $class->next::method(@_);
d38cd95c 75}
efe6365b 76
227d4dee 771;