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