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