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