lib/DBIx/Class/CDBICompat/ColumnGroups.pm

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