discard_changes is also "refresh from storage"
[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / CDBICompat / ColumnGroups.pm
CommitLineData
75d07914 1package # hide from PAUSE
c0e7b4e5 2 DBIx::Class::CDBICompat::ColumnGroups;
ea2e61bf 3
4use strict;
5use warnings;
ea2e61bf 6
75a23b3e 7use base qw/DBIx::Class::Row/;
ea2e61bf 8
9__PACKAGE__->mk_classdata('_column_groups' => { });
10
ea2e61bf 11sub columns {
12 my $proto = shift;
13 my $class = ref $proto || $proto;
14 my $group = shift || "All";
510ca912 15 $class->_add_column_group($group => @_) if @_;
ea2e61bf 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
510ca912 21sub _add_column_group {
ea2e61bf 22 my ($class, $group, @cols) = @_;
510ca912 23 $class->add_columns(@cols);
6a94f7f4 24 $class->_register_column_group($group => @cols);
ea2e61bf 25}
26
27sub _register_column_group {
28 my ($class, $group, @cols) = @_;
b8e1e21f 29
30 my $groups = { %{$class->_column_groups} };
31
ea2e61bf 32 if ($group eq 'Primary') {
510ca912 33 $class->set_primary_key(@cols);
b8e1e21f 34 $groups->{'Essential'}{$_} ||= {} for @cols;
ea2e61bf 35 }
36
ea2e61bf 37 if ($group eq 'All') {
510ca912 38 unless (exists $class->_column_groups->{'Primary'}) {
ea2e61bf 39 $groups->{'Primary'}{$cols[0]} = {};
510ca912 40 $class->set_primary_key($cols[0]);
ea2e61bf 41 }
510ca912 42 unless (exists $class->_column_groups->{'Essential'}) {
ea2e61bf 43 $groups->{'Essential'}{$cols[0]} = {};
44 }
45 }
46
47 $groups->{$group}{$_} ||= {} for @cols;
b8e1e21f 48
ea2e61bf 49 $class->_column_groups($groups);
50}
51
8c49f629 52sub all_columns { return shift->result_source_instance->columns; }
ea2e61bf 53
54sub primary_column {
55 my ($class) = @_;
103647d5 56 my @pri = $class->primary_columns;
ea2e61bf 57 return wantarray ? @pri : $pri[0];
58}
59
60sub find_column {
61 my ($class, $col) = @_;
103647d5 62 return $col if $class->has_column($col);
ea2e61bf 63}
64
65sub __grouper {
66 my ($class) = @_;
04786a4c 67 my $grouper = { class => $class };
68 return bless($grouper, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim');
ea2e61bf 69}
70
71sub _find_columns {
72 my ($class, @col) = @_;
73 return map { $class->find_column($_) } @col;
74}
75
76package DBIx::Class::CDBICompat::ColumnGroups::GrouperShim;
77
78sub 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
901;