Commit | Line | Data |
ea2e61bf |
1 | package DBIx::Class::CDBICompat::ColumnGroups; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | use NEXT; |
6 | |
7 | use base qw/Class::Data::Inheritable/; |
8 | |
9 | __PACKAGE__->mk_classdata('_column_groups' => { }); |
10 | |
11 | sub table { |
12 | shift->_table_name(@_); |
13 | } |
14 | |
15 | sub columns { |
16 | my $proto = shift; |
17 | my $class = ref $proto || $proto; |
18 | my $group = shift || "All"; |
19 | $class->_set_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 _set_column_group { |
26 | my ($class, $group, @cols) = @_; |
27 | $class->_register_column_group($group => @cols); |
8fe001e1 |
28 | #$class->_register_columns(@cols); |
29 | #$class->_mk_column_accessors(@cols); |
30 | $class->set_columns(@cols); |
ea2e61bf |
31 | } |
32 | |
33 | sub _register_column_group { |
34 | my ($class, $group, @cols) = @_; |
35 | if ($group eq 'Primary') { |
8fe001e1 |
36 | $class->set_primary(@cols); |
ea2e61bf |
37 | } |
38 | |
39 | my $groups = { %{$class->_column_groups} }; |
40 | |
41 | if ($group eq 'All') { |
42 | unless ($class->_column_groups->{'Primary'}) { |
43 | $groups->{'Primary'}{$cols[0]} = {}; |
44 | $class->_primaries({ $cols[0] => {} }); |
45 | } |
46 | unless ($class->_column_groups->{'Essential'}) { |
47 | $groups->{'Essential'}{$cols[0]} = {}; |
48 | } |
49 | } |
50 | |
51 | $groups->{$group}{$_} ||= {} for @cols; |
52 | $class->_column_groups($groups); |
53 | } |
54 | |
55 | sub all_columns { return keys %{$_[0]->_columns}; } |
56 | |
57 | sub primary_column { |
58 | my ($class) = @_; |
59 | my @pri = keys %{$class->_primaries}; |
60 | return wantarray ? @pri : $pri[0]; |
61 | } |
62 | |
63 | sub find_column { |
64 | my ($class, $col) = @_; |
65 | return $col if $class->_columns->{$col}; |
66 | } |
67 | |
68 | sub __grouper { |
69 | my ($class) = @_; |
70 | return bless({ class => $class}, '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; |