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