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