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 = ! $target->isa ('DBIx::Class::UTF8Columns');
  19
  20   my @target_isa = do { no strict 'refs'; @{"$target\::ISA"} };
  21   my $base_store_column;
  22
  23   while ($keep_checking && @complist) {
  24
  25     my $comp = pop @complist;
  26
  27     if ($comp->isa ('DBIx::Class::UTF8Columns')) {
  28
  29       $keep_checking = 0;
  30
  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         }
  47       }
  48
  49       carp "Incorrect loading order of $comp by $target will affect other components overriding 'store_column' ("
  50           . join (', ', @broken)
  51           .'). Refer to the documentation of DBIx::Class::UTF8Columns for more info'
  52         if @broken;
  53     }
  54
  55     unshift @target_isa, $comp;
  56   }
  57
  58   $class->next::method(@_);
  59 }
  60
  61 1;