File Coverage

blib/lib/Class/DBI/ColumnGrouper.pm
Criterion Covered Total %
statement 54 57 94.7
branch 19 22 86.4
condition 11 15 73.3
subroutine 17 17 100.0
pod 11 11 100.0
total 112 122 91.8


line stmt bran cond sub pod time code
1             package Class::DBI::ColumnGrouper;
2              
3             =head1 NAME
4            
5             Class::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            
20             Each Class::DBI class maintains a list of its columns as class data.
21             This provides an interface to that. You probably don't want to be dealing
22             with this directly.
23            
24             =head1 METHODS
25            
26             =cut
27              
28 24     24   844 use strict;
  24         466  
  24         350  
29              
30 24     24   357 use Carp;
  24         315  
  24         512  
31 24     24   379 use Storable 'dclone';
  24         209  
  24         474  
32 24     24   1207 use Class::DBI::Column;
  24         237  
  24         2769  
33              
34             sub _unique {
35 20     20   185 my %seen;
36 20 100       202 map { $seen{$_}++ ? () : $_ } @_;
  41         437  
37             }
38              
39             sub _uniq {
40 387     387   3694 my %tmp;
41 387         6505 return grep !$tmp{$_}++, @_;
42             }
43              
44             =head2 new
45            
46             my $colg = Class::DBI::ColumnGrouper->new;
47            
48             A new blank ColumnnGrouper object.
49            
50             =head2 clone
51            
52             my $colg2 = $colg->clone;
53            
54             Clone an existing ColumnGrouper.
55            
56             =cut
57              
58             sub new {
59 24     24 1 278 my $class = shift;
60 24         1009 bless {
61             _groups => {},
62             _cols   => {},
63             }, $class;
64             }
65              
66             sub clone {
67 128     128 1 4613 my ($class, $prev) = @_;
68 128         126247 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            
76             Add or return a Column object for the given column name.
77            
78             =cut
79              
80             sub add_column {
81 239     239 1 7698 my ($self, $col) = @_;
82              
83             # TODO remove this
84 239 50       8046 croak "Need a Column, got $col" unless $col->isa("Class::DBI::Column");
85 239   66     9271 $self->{_allcol}->{ $col->name_lc } ||= $col;
86             }
87              
88             sub find_column {
89 1536     1536 1 58955 my ($self, $name) = @_;
90 1536 100       21044 return $name if ref $name;
91 1107 100       21572 return unless $self->{_allcol}->{ lc $name };
92             }
93              
94             =head2 add_group
95            
96             $colg->add_group(People => qw/star director producer/);
97            
98             This adds a list of columns as a column group.
99            
100             =cut
101              
102             sub add_group {
103 138     138 1 2233 my ($self, $group, @names) = @_;
104 138 100 100     6583 $self->add_group(Primary => $names[0])
      100        
105             if ($group eq "All" or $group eq "Essential")
106             and not $self->group_cols('Primary');
107 138 50 66     4492 $self->add_group(Essential => @names)
108             if $group eq "All"
109             and !$self->essential;
110 138 100       1774 @names = _unique($self->primary, @names) if $group eq "Essential";
111              
112 138         4495 my @cols = map $self->add_column($_), @names;
113 138         19924 $_->add_group($group) foreach @cols;
  138         5637  
114 138         4922 $self->{_groups}->{$group} = \@cols;
115 138         5234 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            
123             This returns a list of all columns which are in the given group, or the
124             groups a given column is in.
125            
126             =cut
127              
128             sub group_cols {
129 2389     2389 1 40890 my ($self, $group) = @_;
130 2389 100       45923 return $self->all_columns if $group eq "All";
131 2371 100       32931 @{ $self->{_groups}->{$group} || [] };
  2371         61027  
132             }
133              
134             sub groups_for {
135 114     114 1 7065 my ($self, @cols) = @_;
136 114         3073 return _uniq(map $_->groups, @cols);
137             }
138              
139             =head2 columns_in
140            
141             my @cols = $colg->columns_in(@groups);
142            
143             This returns a list of all columns which are in the given groups.
144            
145             =cut
146              
147             sub columns_in {
148 274     274 1 4780 my ($self, @groups) = @_;
149 274         17522 return _uniq(map $self->group_cols($_), @groups);
150             }
151              
152             =head2 all_columns
153            
154             my @all = $colg->all_columns;
155            
156             This returns a list of all the real columns.
157            
158             =head2 primary
159            
160             my $pri_col = $colg->primary;
161            
162             This returns a list of the columns in the Primary group.
163            
164             =head2 essential
165            
166             my @essential_cols = $colg->essential;
167            
168             This returns a list of the columns in the Essential group.
169            
170             =cut
171              
172             sub all_columns {
173 175     175 1 3815 my $self = shift;
174 175         1660 return grep $_->in_database, values %{ $self->{_allcol} };
  175         2823  
175             }
176              
177             sub primary {
178 2028     2028 1 138479 my @cols = shift->group_cols('Primary');
179 2028 50 33     51278 if (!wantarray && @cols > 1) {
180 0         0 local ($Carp::CarpLevel) = 1;
181 0         0 confess(
182             "Multiple columns in Primary group (@cols) but primary called in scalar context"
183             );
184 0         0 return $cols[0];
185             }
186 2028         57964 return @cols;
187             }
188              
189             sub essential {
190 163     163 1 5816 my $self = shift;
191 163         2241 my @cols = $self->columns_in('Essential');
192 163 100       8918 @cols = $self->primary unless @cols;
193 163         2612 return @cols;
194             }
195              
196             1;
197