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->_init_result_source_instance();
  16
  17   $class->_add_column_group($group => @_) if @_;
  18   return $class->all_columns    if $group eq "All";
  19   return $class->primary_column if $group eq "Primary";
  20   return keys %{$class->_column_groups->{$group}};
  21 }
  22
  23 sub _add_column_group {
  24   my ($class, $group, @cols) = @_;
  25   $class->add_columns(@cols);
  26   $class->_register_column_group($group => @cols);
  27 }
  28
  29 sub _register_column_group {
  30   my ($class, $group, @cols) = @_;
  31
  32   my $groups = { %{$class->_column_groups} };
  33
  34   if ($group eq 'Primary') {
  35     $class->set_primary_key(@cols);
  36     $groups->{'Essential'}{$_} ||= {} for @cols;
  37   }
  38
  39   if ($group eq 'All') {
  40     unless (exists $class->_column_groups->{'Primary'}) {
  41       $groups->{'Primary'}{$cols[0]} = {};
  42       $class->set_primary_key($cols[0]);
  43     }
  44     unless (exists $class->_column_groups->{'Essential'}) {
  45       $groups->{'Essential'}{$cols[0]} = {};
  46     }
  47   }
  48
  49   $groups->{$group}{$_} ||= {} for @cols;
  50
  51   $class->_column_groups($groups);
  52 }
  53
  54 sub all_columns { return shift->result_source_instance->columns; }
  55
  56 sub primary_column {
  57   my ($class) = @_;
  58   my @pri = $class->primary_columns;
  59   return wantarray ? @pri : $pri[0];
  60 }
  61
  62 sub find_column {
  63   my ($class, $col) = @_;
  64   return $col if $class->has_column($col);
  65 }
  66
  67 sub __grouper {
  68   my ($class) = @_;
  69   my $grouper = { class => $class };
  70   return bless($grouper, '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;