lib/DBIx/Class/CDBICompat/ColumnGroups.pm

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