1package Class::DBI::Column; 2 3=head1 NAME 4 5Class::DBI::Column - A column in a table 6 7=head1 SYNOPSIS 8 9 my $column = Class::DBI::Column->new($name); 10 11 my $name = $column->name; 12 13 my @groups = $column->groups; 14 my $pri_col = $colg->primary; 15 16 if ($column->in_database) { ... } 17 18=head1 DESCRIPTION 19 20Each Class::DBI class maintains a list of its columns as class data. 21This provides an interface to those columns. You probably shouldn't be 22dealing with this directly. 23 24=head1 METHODS 25 26=cut 27 28use strict; 29use base 'Class::Accessor::Fast'; 30use Carp; 31 32__PACKAGE__->mk_accessors( 33 qw/name accessor mutator placeholder is_constrained/ 34); 35 36use overload 37 '""' => sub { shift->name_lc }, 38 fallback => 1; 39 40=head2 new 41 42 my $column = Class::DBI::Column->new($column) 43 44A new object for this column. 45 46=cut 47 48sub new { 49 my $class = shift; 50 my $name = shift or croak "Column needs a name"; 51 my $opt = shift || {}; 52 return $class->SUPER::new( 53 { 54 name => $name, 55 accessor => $name, 56 mutator => $name, 57 _groups => {}, 58 placeholder => '?', 59 %$opt, 60 } 61 ); 62} 63 64sub name_lc { lc shift->name } 65 66sub add_group { 67 my ($self, $group) = @_; 68 $self->{_groups}->{$group} = 1; 69} 70 71sub groups { 72 my $self = shift; 73 my %groups = %{ $self->{_groups} }; 74 delete $groups{All} if keys %groups > 1; 75 return keys %groups; 76} 77 78sub in_database { 79 return !scalar grep $_ eq "TEMP", shift->groups; 80} 81 821; 83