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 Storable 'dclone';
   8
   9 use base qw/DBIx::Class::Row/;
  10
  11 __PACKAGE__->mk_classdata('_column_groups' => { });
  12
  13 sub columns {
  14   my $proto = shift;
  15   my $class = ref $proto || $proto;
  16   my $group = shift || "All";
  17   $class->_init_result_source_instance();
  18
  19   $class->_add_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 _add_column_group {
  26   my ($class, $group, @cols) = @_;
  27   $class->add_columns(@cols);
  28   $class->_register_column_group($group => @cols);
  29 }
  30
  31 sub _register_column_group {
  32   my ($class, $group, @cols) = @_;
  33
  34   # Must do a complete deep copy else column groups
  35   # might accidentally be shared.
  36   my $groups = dclone $class->_column_groups;
  37
  38   if ($group eq 'Primary') {
  39     $class->set_primary_key(@cols);
  40     $groups->{'Essential'}{$_} ||= 1 for @cols;
  41   }
  42
  43   if ($group eq 'All') {
  44     unless (exists $class->_column_groups->{'Primary'}) {
  45       $groups->{'Primary'}{$cols[0]} = 1;
  46       $class->set_primary_key($cols[0]);
  47     }
  48     unless (exists $class->_column_groups->{'Essential'}) {
  49       $groups->{'Essential'}{$cols[0]} = 1;
  50     }
  51   }
  52
  53   $groups->{$group}{$_} ||= 1 for @cols;
  54
  55   $class->_column_groups($groups);
  56 }
  57
  58 sub all_columns { return shift->result_source_instance->columns; }
  59
  60 sub primary_column {
  61   my ($class) = @_;
  62   my @pri = $class->primary_columns;
  63   return wantarray ? @pri : $pri[0];
  64 }
  65
  66 sub find_column {
  67   my ($class, $col) = @_;
  68   return $col if $class->has_column($col);
  69 }
  70
  71 sub __grouper {
  72   my ($class) = @_;
  73   my $grouper = { class => $class };
  74   return bless($grouper, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim');
  75 }
  76
  77 sub _find_columns {
  78   my ($class, @col) = @_;
  79   return map { $class->find_column($_) } @col;
  80 }
  81
  82 package DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
  83
  84 sub groups_for {
  85   my ($self, @cols) = @_;
  86   my %groups;
  87   foreach my $col (@cols) {
  88     foreach my $group (keys %{$self->{class}->_column_groups}) {
  89       $groups{$group} = 1 if $self->{class}->_column_groups->{$group}->{$col};
  90     }
  91   }
  92   return keys %groups;
  93 }
  94
  95
  96 1;