Commit | Line | Data |
75d07914 |
1 | package # hide from PAUSE |
c0e7b4e5 |
2 | DBIx::Class::CDBICompat::ColumnGroups; |
ea2e61bf |
3 | |
4 | use strict; |
5 | use warnings; |
ea2e61bf |
6 | |
96eab6f8 |
7 | use Storable 'dclone'; |
8 | |
75a23b3e |
9 | use base qw/DBIx::Class::Row/; |
ea2e61bf |
10 | |
11 | __PACKAGE__->mk_classdata('_column_groups' => { }); |
12 | |
ea2e61bf |
13 | sub columns { |
14 | my $proto = shift; |
15 | my $class = ref $proto || $proto; |
16 | my $group = shift || "All"; |
e60dc79f |
17 | $class->_init_result_source_instance(); |
18 | |
510ca912 |
19 | $class->_add_column_group($group => @_) if @_; |
ea2e61bf |
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 | |
510ca912 |
25 | sub _add_column_group { |
ea2e61bf |
26 | my ($class, $group, @cols) = @_; |
510ca912 |
27 | $class->add_columns(@cols); |
6a94f7f4 |
28 | $class->_register_column_group($group => @cols); |
ea2e61bf |
29 | } |
30 | |
31 | sub _register_column_group { |
32 | my ($class, $group, @cols) = @_; |
b8e1e21f |
33 | |
96eab6f8 |
34 | # Must do a complete deep copy else column groups |
35 | # might accidentally be shared. |
36 | my $groups = dclone $class->_column_groups; |
b8e1e21f |
37 | |
ea2e61bf |
38 | if ($group eq 'Primary') { |
510ca912 |
39 | $class->set_primary_key(@cols); |
8eae3205 |
40 | $groups->{'Essential'}{$_} ||= 1 for @cols; |
ea2e61bf |
41 | } |
42 | |
ea2e61bf |
43 | if ($group eq 'All') { |
510ca912 |
44 | unless (exists $class->_column_groups->{'Primary'}) { |
8eae3205 |
45 | $groups->{'Primary'}{$cols[0]} = 1; |
510ca912 |
46 | $class->set_primary_key($cols[0]); |
ea2e61bf |
47 | } |
510ca912 |
48 | unless (exists $class->_column_groups->{'Essential'}) { |
8eae3205 |
49 | $groups->{'Essential'}{$cols[0]} = 1; |
ea2e61bf |
50 | } |
51 | } |
52 | |
8eae3205 |
53 | $groups->{$group}{$_} ||= 1 for @cols; |
b8e1e21f |
54 | |
ea2e61bf |
55 | $class->_column_groups($groups); |
56 | } |
57 | |
8c49f629 |
58 | sub all_columns { return shift->result_source_instance->columns; } |
ea2e61bf |
59 | |
60 | sub primary_column { |
61 | my ($class) = @_; |
103647d5 |
62 | my @pri = $class->primary_columns; |
ea2e61bf |
63 | return wantarray ? @pri : $pri[0]; |
64 | } |
65 | |
66 | sub find_column { |
67 | my ($class, $col) = @_; |
103647d5 |
68 | return $col if $class->has_column($col); |
ea2e61bf |
69 | } |
70 | |
71 | sub __grouper { |
72 | my ($class) = @_; |
04786a4c |
73 | my $grouper = { class => $class }; |
74 | return bless($grouper, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim'); |
ea2e61bf |
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; |