Add an explicit Sub::Quote dep in ::_Util
[dbsrgits/DBIx-Class-Historic.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 mro 'c3';
9
86a432d4 10use DBIx::Class::_Util 'get_subname';
70c28808 11use DBIx::Class::Carp '^DBIx::Class|^Class::C3::Componentised';
64c50e81 12use 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
1b12190d 16#
17# and also enforces C3 mro on all components
18my $mro_already_set;
d38cd95c 19sub inject_base {
20 my $class = shift;
1415f198 21 my ($target, @complist) = @_;
d38cd95c 22
1415f198 23 # we already did load the component
05d90040 24 my $keep_checking = ! (
25 $target->isa ('DBIx::Class::UTF8Columns')
26 ||
27 $target->isa ('DBIx::Class::ForceUTF8')
28 );
d38cd95c 29
3c2a505c 30 my @target_isa;
7146f619 31
1415f198 32 while ($keep_checking && @complist) {
33
05d90040 34 @target_isa = do { no strict 'refs'; @{"$target\::ISA"} }
35 unless @target_isa;
36
1415f198 37 my $comp = pop @complist;
7146f619 38
3c2a505c 39 # warn here on use of either component, as we have no access to ForceUTF8,
40 # the author does not respond, and the Catalyst wiki used to recommend it
41 for (qw/DBIx::Class::UTF8Columns DBIx::Class::ForceUTF8/) {
42 if ($comp->isa ($_) ) {
43 $keep_checking = 0; # no use to check from this point on
70c28808 44 carp_once "Use of $_ is strongly discouraged. See documentation of DBIx::Class::UTF8Columns for more info\n"
45 unless $ENV{DBIC_UTF8COLUMNS_OK};
3c2a505c 46 last;
47 }
48 }
72ae8e40 49
3c2a505c 50 # something unset $keep_checking - we got a unicode mangler
51 if (! $keep_checking) {
1415f198 52
3c2a505c 53 my $base_store_column = do { require DBIx::Class::Row; DBIx::Class::Row->can ('store_column') };
05d90040 54
1415f198 55 my @broken;
56 for my $existing_comp (@target_isa) {
57 my $sc = $existing_comp->can ('store_column')
58 or next;
59
60 if ($sc ne $base_store_column) {
86a432d4 61 my ($definer) = get_subname($sc);
1415f198 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
1b12190d 78 # only examine from $_[2] onwards
79 # C::C3::C already sets c3 on $_[1]
80 mro::set_mro( $_ => 'c3' ) for grep {
81 $mro_already_set->{$_} ? 0 : ( $mro_already_set->{$_} = 1 )
82 } @_[1 .. $#_];
83
1415f198 84 $class->next::method(@_);
d38cd95c 85}
efe6365b 86
227d4dee 871;