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 |
12 | sub inject_base { |
13 | my $class = shift; |
14 | my $target = shift; |
15 | |
16 | my @present_components = (@{mro::get_linear_isa ($target)||[]}); |
72ae8e40 |
17 | shift @present_components; # don't need to interrogate myself |
d38cd95c |
18 | |
19 | no strict 'refs'; |
20 | for my $comp (reverse @_) { |
7146f619 |
21 | |
72ae8e40 |
22 | # if we are trying add a UTF8Columns component *for the first time* |
23 | if ($comp->isa ('DBIx::Class::UTF8Columns') && ! $target->isa ('DBIx::Class::UTF8Columns') ) { |
7146f619 |
24 | require B; |
25 | my @broken; |
26 | |
27 | for (@present_components) { |
72ae8e40 |
28 | last if $_ eq 'DBIx::Class::Row'; # don't care about anything further down the chain |
29 | |
7146f619 |
30 | my $cref = $_->can ('store_column') |
31 | or next; |
72ae8e40 |
32 | |
33 | push @broken, $_ if B::svref_2object($cref)->STASH->NAME eq $_; |
7146f619 |
34 | } |
35 | |
d38cd95c |
36 | carp "Incorrect loading order of $comp by ${target} will affect other components overriding store_column (" |
37 | . join (', ', @broken) |
7146f619 |
38 | .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info' |
39 | if @broken; |
d38cd95c |
40 | } |
7146f619 |
41 | |
42 | unshift @present_components, $comp; |
d38cd95c |
43 | } |
44 | |
45 | $class->next::method($target, @_); |
46 | } |
efe6365b |
47 | |
227d4dee |
48 | 1; |