Commit | Line | Data |
---|---|---|
75d07914 | 1 | package # hide from PAUSE |
c0e7b4e5 | 2 | DBIx::Class::Componentised; |
227d4dee | 3 | |
bf5ecff9 | 4 | use strict; |
5 | use warnings; | |
6 | ||
48a76fcf | 7 | use base 'Class::C3::Componentised'; |
d38cd95c | 8 | use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/; |
9 | use mro 'c3'; | |
10 | ||
11 | # this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column | |
1415f198 | 12 | # if and only if it is placed before something overriding store_column |
d38cd95c | 13 | sub inject_base { |
14 | my $class = shift; | |
1415f198 | 15 | my ($target, @complist) = @_; |
d38cd95c | 16 | |
1415f198 | 17 | # we already did load the component |
18 | my $keep_checking = ! $target->isa ('DBIx::Class::UTF8Columns'); | |
d38cd95c | 19 | |
1415f198 | 20 | my @target_isa = do { no strict 'refs'; @{"$target\::ISA"} }; |
21 | my $base_store_column; | |
7146f619 | 22 | |
1415f198 | 23 | while ($keep_checking && @complist) { |
24 | ||
25 | my $comp = pop @complist; | |
7146f619 | 26 | |
1415f198 | 27 | if ($comp->isa ('DBIx::Class::UTF8Columns')) { |
72ae8e40 | 28 | |
1415f198 | 29 | $keep_checking = 0; |
72ae8e40 | 30 | |
1415f198 | 31 | $base_store_column ||= |
32 | do { require DBIx::Class::Row; DBIx::Class::Row->can ('store_column') }; | |
33 | ||
34 | my @broken; | |
35 | for my $existing_comp (@target_isa) { | |
36 | my $sc = $existing_comp->can ('store_column') | |
37 | or next; | |
38 | ||
39 | if ($sc ne $base_store_column) { | |
40 | require B; | |
41 | my $definer = B::svref_2object($sc)->STASH->NAME; | |
42 | push @broken, ($definer eq $existing_comp) | |
43 | ? $existing_comp | |
44 | : "$existing_comp (via $definer)" | |
45 | ; | |
46 | } | |
7146f619 | 47 | } |
48 | ||
1415f198 | 49 | carp "Incorrect loading order of $comp by $target will affect other components overriding 'store_column' (" |
d38cd95c | 50 | . join (', ', @broken) |
7146f619 | 51 | .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info' |
1415f198 | 52 | if @broken; |
d38cd95c | 53 | } |
7146f619 | 54 | |
1415f198 | 55 | unshift @target_isa, $comp; |
d38cd95c | 56 | } |
57 | ||
1415f198 | 58 | $class->next::method(@_); |
d38cd95c | 59 | } |
efe6365b | 60 | |
227d4dee | 61 | 1; |