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
  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       #$class->_register_column_group('Essential' => $cols[0]);
  44       $groups->{'Essential'}{$cols[0]} = {};
  45       #$groups->{'Essential'}{$_} ||= {} for keys %{ $class->_primaries || {} };
  46     }
  47   }
  48
  49   $groups->{$group}{$_} ||= {} for @cols;
  50   #if ($group eq 'Essential') {
  51   #  $groups->{$group}{$_} ||= {} for keys %{ $class->_primaries || {} };
  52   #}
  53
  54   $class->_column_groups($groups);
  55 }
  56
  57 sub all_columns { return keys %{$_[0]->_columns}; }
  58
  59 sub primary_column {
  60   my ($class) = @_;
  61   my @pri = $class->primary_columns;
  62   return wantarray ? @pri : $pri[0];
  63 }
  64
  65 sub find_column {
  66   my ($class, $col) = @_;
  67   return $col if $class->has_column($col);
  68 }
  69
  70 sub __grouper {
  71   my ($class) = @_;
  72   return bless({ class => $class}, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim');
  73 }
  74
  75 sub _find_columns {
  76   my ($class, @col) = @_;
  77   return map { $class->find_column($_) } @col;
  78 }
  79
  80 package DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
  81
  82 sub groups_for {
  83   my ($self, @cols) = @_;
  84   my %groups;
  85   foreach my $col (@cols) {
  86     foreach my $group (keys %{$self->{class}->_column_groups}) {
  87       $groups{$group} = 1 if $self->{class}->_column_groups->{$group}->{$col};
  88     }
  89   }
  90   return keys %groups;
  91 }
  92
  93
  94 1;