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 |
05d90040 | 18 | my $keep_checking = ! ( |
19 | $target->isa ('DBIx::Class::UTF8Columns') | |
20 | || | |
21 | $target->isa ('DBIx::Class::ForceUTF8') | |
22 | ); | |
d38cd95c | 23 | |
05d90040 | 24 | my (@target_isa, $base_store_column); |
7146f619 | 25 | |
1415f198 | 26 | while ($keep_checking && @complist) { |
27 | ||
05d90040 | 28 | @target_isa = do { no strict 'refs'; @{"$target\::ISA"} } |
29 | unless @target_isa; | |
30 | ||
1415f198 | 31 | my $comp = pop @complist; |
7146f619 | 32 | |
05d90040 | 33 | if ($comp->isa ('DBIx::Class::UTF8Columns') || $comp->isa ('DBIx::Class::ForceUTF8') { |
72ae8e40 | 34 | |
1415f198 | 35 | $keep_checking = 0; |
72ae8e40 | 36 | |
1415f198 | 37 | $base_store_column ||= |
38 | do { require DBIx::Class::Row; DBIx::Class::Row->can ('store_column') }; | |
39 | ||
05d90040 | 40 | |
1415f198 | 41 | my @broken; |
42 | for my $existing_comp (@target_isa) { | |
43 | my $sc = $existing_comp->can ('store_column') | |
44 | or next; | |
45 | ||
46 | if ($sc ne $base_store_column) { | |
47 | require B; | |
48 | my $definer = B::svref_2object($sc)->STASH->NAME; | |
49 | push @broken, ($definer eq $existing_comp) | |
50 | ? $existing_comp | |
51 | : "$existing_comp (via $definer)" | |
52 | ; | |
53 | } | |
7146f619 | 54 | } |
55 | ||
1415f198 | 56 | carp "Incorrect loading order of $comp by $target will affect other components overriding 'store_column' (" |
d38cd95c | 57 | . join (', ', @broken) |
7146f619 | 58 | .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info' |
1415f198 | 59 | if @broken; |
d38cd95c | 60 | } |
7146f619 | 61 | |
1415f198 | 62 | unshift @target_isa, $comp; |
d38cd95c | 63 | } |
64 | ||
1415f198 | 65 | $class->next::method(@_); |
d38cd95c | 66 | } |
efe6365b | 67 | |
227d4dee | 68 | 1; |