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 table {
  12   shift->_table_name(@_);
  13 }
  14
  15 sub columns {
  16   my $proto = shift;
  17   my $class = ref $proto || $proto;
  18   my $group = shift || "All";
  19   $class->_set_column_group($group => @_) if @_;
  20   return $class->all_columns    if $group eq "All";
  21   return $class->primary_column if $group eq "Primary";
  22   return keys %{$class->_column_groups->{$group}};
  23 }
  24
  25 sub _set_column_group {
  26   my ($class, $group, @cols) = @_;
  27   $class->_register_column_group($group => @cols);
  28   #$class->_register_columns(@cols);
  29   #$class->_mk_column_accessors(@cols);
  30   $class->set_columns(@cols);
  31 }
  32
  33 sub _register_column_group {
  34   my ($class, $group, @cols) = @_;
  35   if ($group eq 'Primary') {
  36     $class->set_primary(@cols);
  37   }
  38
  39   my $groups = { %{$class->_column_groups} };
  40
  41   if ($group eq 'All') {
  42     unless ($class->_column_groups->{'Primary'}) {
  43       $groups->{'Primary'}{$cols[0]} = {};
  44       $class->_primaries({ $cols[0] => {} });
  45     }
  46     unless ($class->_column_groups->{'Essential'}) {
  47       $groups->{'Essential'}{$cols[0]} = {};
  48     }
  49   }
  50
  51   $groups->{$group}{$_} ||= {} for @cols;
  52   $class->_column_groups($groups);
  53 }
  54
  55 sub all_columns { return keys %{$_[0]->_columns}; }
  56
  57 sub primary_column {
  58   my ($class) = @_;
  59   my @pri = keys %{$class->_primaries};
  60   return wantarray ? @pri : $pri[0];
  61 }
  62
  63 sub find_column {
  64   my ($class, $col) = @_;
  65   return $col if $class->_columns->{$col};
  66 }
  67
  68 sub __grouper {
  69   my ($class) = @_;
  70   return bless({ class => $class}, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim');
  71 }
  72
  73 sub _find_columns {
  74   my ($class, @col) = @_;
  75   return map { $class->find_column($_) } @col;
  76 }
  77
  78 package DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
  79
  80 sub groups_for {
  81   my ($self, @cols) = @_;
  82   my %groups;
  83   foreach my $col (@cols) {
  84     foreach my $group (keys %{$self->{class}->_column_groups}) {
  85       $groups{$group} = 1 if $self->{class}->_column_groups->{$group}->{$col};
  86     }
  87   }
  88   return keys %groups;
  89 }
  90
  91
  92 1;