1package Class::DBI::ColumnGrouper;
2
3=head1 NAME
4
5Class::DBI::ColumnGrouper - Columns and Column Groups
6
7=head1 SYNOPSIS
8
9	my $colg = Class::DBI::ColumnGrouper->new;
10	   $colg->add_group(People => qw/star director producer/);
11
12	my @cols = $colg->group_cols($group);
13
14	my @all            = $colg->all_columns;
15	my @pri_col        = $colg->primary;
16	my @essential_cols = $colg->essential;
17
18=head1 DESCRIPTION
19
20Each Class::DBI class maintains a list of its columns as class data.
21This provides an interface to that. You probably don't want to be dealing
22with this directly.
23
24=head1 METHODS
25
26=cut
27
28use strict;
29
30use Carp;
31use Storable 'dclone';
32use Class::DBI::Column;
33
34sub _unique {
35	my %seen;
36	map { $seen{$_}++ ? () : $_ } @_;
37}
38
39sub _uniq {
40	my %tmp;
41	return grep !$tmp{$_}++, @_;
42}
43
44=head2 new
45
46	my $colg = Class::DBI::ColumnGrouper->new;
47
48A new blank ColumnnGrouper object.
49
50=head2 clone
51
52	my $colg2 = $colg->clone;
53
54Clone an existing ColumnGrouper.
55
56=cut
57
58sub new {
59	my $class = shift;
60	bless {
61		_groups => {},
62		_cols   => {},
63	}, $class;
64}
65
66sub clone {
67	my ($class, $prev) = @_;
68	return dclone $prev;
69}
70
71=head2 add_column / find_column
72
73	$colg->add_column($name);
74	my Class::DBI::Column $col = $colg->find_column($name);
75
76Add or return a Column object for the given column name.
77
78=cut
79
80sub add_column {
81	my ($self, $col) = @_;
82
83	# TODO remove this
84	croak "Need a Column, got $col" unless $col->isa("Class::DBI::Column");
85	$self->{_allcol}->{ $col->name_lc } ||= $col;
86}
87
88sub find_column {
89	my ($self, $name) = @_;
90	return $name if ref $name;
91	return unless $self->{_allcol}->{ lc $name };
92}
93
94=head2 add_group
95
96	$colg->add_group(People => qw/star director producer/);
97
98This adds a list of columns as a column group.
99
100=cut
101
102sub add_group {
103	my ($self, $group, @names) = @_;
104	$self->add_group(Primary => $names[0])
105		if ($group eq "All" or $group eq "Essential")
106		and not $self->group_cols('Primary');
107	$self->add_group(Essential => @names)
108		if $group eq "All"
109		and !$self->essential;
110	@names = _unique($self->primary, @names) if $group eq "Essential";
111
112	my @cols = map $self->add_column($_), @names;
113	$_->add_group($group) foreach @cols;
114	$self->{_groups}->{$group} = \@cols;
115	return $self;
116}
117
118=head2 group_cols / groups_for
119
120	my @colg = $cols->group_cols($group);
121	my @groups = $cols->groups_for(@cols);
122
123This returns a list of all columns which are in the given group, or the
124groups a given column is in.
125
126=cut
127
128sub group_cols {
129	my ($self, $group) = @_;
130	return $self->all_columns if $group eq "All";
131	@{ $self->{_groups}->{$group} || [] };
132}
133
134sub groups_for {
135	my ($self, @cols) = @_;
136	return _uniq(map $_->groups, @cols);
137}
138
139=head2 columns_in
140
141	my @cols = $colg->columns_in(@groups);
142
143This returns a list of all columns which are in the given groups.
144
145=cut
146
147sub columns_in {
148	my ($self, @groups) = @_;
149	return _uniq(map $self->group_cols($_), @groups);
150}
151
152=head2 all_columns
153
154	my @all = $colg->all_columns;
155
156This returns a list of all the real columns.
157
158=head2 primary
159
160	my $pri_col = $colg->primary;
161
162This returns a list of the columns in the Primary group.
163
164=head2 essential
165
166	my @essential_cols = $colg->essential;
167
168This returns a list of the columns in the Essential group.
169
170=cut
171
172sub all_columns {
173	my $self = shift;
174	return grep $_->in_database, values %{ $self->{_allcol} };
175}
176
177sub primary {
178	my @cols = shift->group_cols('Primary');
179	if (!wantarray && @cols > 1) {
180		local ($Carp::CarpLevel) = 1;
181		confess(
182			"Multiple columns in Primary group (@cols) but primary called in scalar context"
183		);
184		return $cols[0];
185	}
186	return @cols;
187}
188
189sub essential {
190	my $self = shift;
191	my @cols = $self->columns_in('Essential');
192	@cols = $self->primary unless @cols;
193	return @cols;
194}
195
1961;
197