Add an explicit Sub::Quote dep in ::_Util
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Componentised.pm
1 package # hide from PAUSE
2     DBIx::Class::Componentised;
3
4 use strict;
5 use warnings;
6
7 use base 'Class::C3::Componentised';
8 use mro 'c3';
9
10 use DBIx::Class::_Util 'get_subname';
11 use DBIx::Class::Carp '^DBIx::Class|^Class::C3::Componentised';
12 use namespace::clean;
13
14 # this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column
15 # if and only if it is placed before something overriding store_column
16 #
17 # and also enforces C3 mro on all components
18 my $mro_already_set;
19 sub inject_base {
20   my $class = shift;
21   my ($target, @complist) = @_;
22
23   # we already did load the component
24   my $keep_checking = ! (
25     $target->isa ('DBIx::Class::UTF8Columns')
26       ||
27     $target->isa ('DBIx::Class::ForceUTF8')
28   );
29
30   my @target_isa;
31
32   while ($keep_checking && @complist) {
33
34     @target_isa = do { no strict 'refs'; @{"$target\::ISA"} }
35       unless @target_isa;
36
37     my $comp = pop @complist;
38
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
44         carp_once "Use of $_ is strongly discouraged. See documentation of DBIx::Class::UTF8Columns for more info\n"
45           unless $ENV{DBIC_UTF8COLUMNS_OK};
46         last;
47       }
48     }
49
50     # something unset $keep_checking - we got a unicode mangler
51     if (! $keep_checking) {
52
53       my $base_store_column = do { require DBIx::Class::Row; DBIx::Class::Row->can ('store_column') };
54
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) {
61           my ($definer) = get_subname($sc);
62           push @broken, ($definer eq $existing_comp)
63             ? $existing_comp
64             : "$existing_comp (via $definer)"
65           ;
66         }
67       }
68
69       carp "Incorrect loading order of $comp by $target will affect other components overriding 'store_column' ("
70           . join (', ', @broken)
71           .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info'
72         if @broken;
73     }
74
75     unshift @target_isa, $comp;
76   }
77
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
84   $class->next::method(@_);
85 }
86
87 1;