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