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 # this warns of subtle bugs introduced by UTF8Columns hacky handling of store_column
  12 # if and only if it is placed before something overriding store_column
  13 sub inject_base {
  14   my $class = shift;
  15   my ($target, @complist) = @_;
  16
  17   # we already did load the component
  18   my $keep_checking = ! (
  19     $target->isa ('DBIx::Class::UTF8Columns')
  20       ||
  21     $target->isa ('DBIx::Class::ForceUTF8')
  22   );
  23
  24   my (@target_isa, $base_store_column);
  25
  26   while ($keep_checking && @complist) {
  27
  28     @target_isa = do { no strict 'refs'; @{"$target\::ISA"} }
  29       unless @target_isa;
  30
  31     my $comp = pop @complist;
  32
  33     if ($comp->isa ('DBIx::Class::UTF8Columns') || $comp->isa ('DBIx::Class::ForceUTF8') {
  34
  35       $keep_checking = 0;
  36
  37       $base_store_column ||=
  38         do { require DBIx::Class::Row; DBIx::Class::Row->can ('store_column') };
  39
  40
  41       my @broken;
  42       for my $existing_comp (@target_isa) {
  43         my $sc = $existing_comp->can ('store_column')
  44           or next;
  45
  46         if ($sc ne $base_store_column) {
  47           require B;
  48           my $definer = B::svref_2object($sc)->STASH->NAME;
  49           push @broken, ($definer eq $existing_comp)
  50             ? $existing_comp
  51             : "$existing_comp (via $definer)"
  52           ;
  53         }
  54       }
  55
  56       carp "Incorrect loading order of $comp by $target will affect other components overriding 'store_column' ("
  57           . join (', ', @broken)
  58           .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info'
  59         if @broken;
  60     }
  61
  62     unshift @target_isa, $comp;
  63   }
  64
  65   $class->next::method(@_);
  66 }
  67
  68 1;