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