use min dbms_version for ::Replicated
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Componentised.pm
CommitLineData
75d07914 1package # hide from PAUSE
c0e7b4e5 2 DBIx::Class::Componentised;
227d4dee 3
bf5ecff9 4use strict;
5use warnings;
6
48a76fcf 7use base 'Class::C3::Componentised';
d38cd95c 8use Carp::Clan qw/^DBIx::Class|^Class::C3::Componentised/;
9use 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 13sub inject_base {
14 my $class = shift;
1415f198 15 my ($target, @complist) = @_;
d38cd95c 16
1415f198 17 # we already did load the component
18 my $keep_checking = ! $target->isa ('DBIx::Class::UTF8Columns');
d38cd95c 19
1415f198 20 my @target_isa = do { no strict 'refs'; @{"$target\::ISA"} };
21 my $base_store_column;
7146f619 22
1415f198 23 while ($keep_checking && @complist) {
24
25 my $comp = pop @complist;
7146f619 26
1415f198 27 if ($comp->isa ('DBIx::Class::UTF8Columns')) {
72ae8e40 28
1415f198 29 $keep_checking = 0;
72ae8e40 30
1415f198 31 $base_store_column ||=
32 do { require DBIx::Class::Row; DBIx::Class::Row->can ('store_column') };
33
34 my @broken;
35 for my $existing_comp (@target_isa) {
36 my $sc = $existing_comp->can ('store_column')
37 or next;
38
39 if ($sc ne $base_store_column) {
40 require B;
41 my $definer = B::svref_2object($sc)->STASH->NAME;
42 push @broken, ($definer eq $existing_comp)
43 ? $existing_comp
44 : "$existing_comp (via $definer)"
45 ;
46 }
7146f619 47 }
48
1415f198 49 carp "Incorrect loading order of $comp by $target will affect other components overriding 'store_column' ("
d38cd95c 50 . join (', ', @broken)
7146f619 51 .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info'
1415f198 52 if @broken;
d38cd95c 53 }
7146f619 54
1415f198 55 unshift @target_isa, $comp;
d38cd95c 56 }
57
1415f198 58 $class->next::method(@_);
d38cd95c 59}
efe6365b 60
227d4dee 611;