lib/DBIx/Class/CDBICompat/ColumnGroups.pm

   1 package DBIx::Class::CDBICompat::ColumnGroups;
   2
   3 use strict;
   4 use warnings;
   5 use NEXT;
   6
   7 use base qw/Class::Data::Inheritable/;
   8
   9 __PACKAGE__->mk_classdata('_column_groups' => { });
  10
  11 sub columns {
  12   my $proto = shift;
  13   my $class = ref $proto || $proto;
  14   my $group = shift || "All";
  15   $class->_add_column_group($group => @_) if @_;
  16   return $class->all_columns    if $group eq "All";
  17   return $class->primary_column if $group eq "Primary";
  18   return keys %{$class->_column_groups->{$group}};
  19 }
  20
  21 sub _add_column_group {
  22   my ($class, $group, @cols) = @_;
  23   $class->_register_column_group($group => @cols);
  24   $class->add_columns(@cols);
  25 }
  26
  27 sub _register_column_group {
  28   my ($class, $group, @cols) = @_;
  29   if ($group eq 'Primary') {
  30     $class->set_primary_key(@cols);
  31   }
  32
  33   my $groups = { %{$class->_column_groups} };
  34
  35   if ($group eq 'All') {
  36     unless (exists $class->_column_groups->{'Primary'}) {
  37       $groups->{'Primary'}{$cols[0]} = {};
  38       $class->set_primary_key($cols[0]);
  39     }
  40     unless (exists $class->_column_groups->{'Essential'}) {
  41       $groups->{'Essential'}{$cols[0]} = {};
  42     }
  43   }
  44
  45   $groups->{$group}{$_} ||= {} for @cols;
  46   if ($group eq 'Essential') {
  47     $groups->{$group}{$_} ||= {} for keys %{ $class->_primaries || {} };
  48   }
  49   $class->_column_groups($groups);
  50 }
  51
  52 sub all_columns { return keys %{$_[0]->_columns}; }
  53
  54 sub primary_column {
  55   my ($class) = @_;
  56   my @pri = keys %{$class->_primaries};
  57   return wantarray ? @pri : $pri[0];
  58 }
  59
  60 sub find_column {
  61   my ($class, $col) = @_;
  62   return $col if $class->_columns->{$col};
  63 }
  64
  65 sub __grouper {
  66   my ($class) = @_;
  67   return bless({ class => $class}, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim');
  68 }
  69
  70 sub _find_columns {
  71   my ($class, @col) = @_;
  72   return map { $class->find_column($_) } @col;
  73 }
  74
  75 package DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
  76
  77 sub groups_for {
  78   my ($self, @cols) = @_;
  79   my %groups;
  80   foreach my $col (@cols) {
  81     foreach my $group (keys %{$self->{class}->_column_groups}) {
  82       $groups{$group} = 1 if $self->{class}->_column_groups->{$group}->{$col};
  83     }
  84   }
  85   return keys %groups;
  86 }
  87
  88
  89 1;