File Coverage

blib/lib/Class/DBI/Frozen/301/Column.pm
Criterion Covered Total %
statement 21 21 100.0
branch 2 2 100.0
condition n/a
subroutine 9 9 100.0
pod 1 5 20.0
total 33 37 89.1


line stmt bran cond sub pod time code
1             package Class::DBI::Column;
2              
3             =head1 NAME
4              
5             Class::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              
20             Each Class::DBI class maintains a list of its columns as class data.
21             This provides an interface to those columns. You probably shouldn't be
22             dealing with this directly.
23              
24             =head1 METHODS
25              
26             =cut
27              
28 24     24   145 use strict;
  24         52  
  24         2332  
29 24     24   131 use base 'Class::Accessor';
  24         41  
  24         357733  
30              
31             __PACKAGE__->mk_accessors(
32             qw/name accessor mutator placeholder
33             is_constrained/
34             );
35              
36             use overload
37 308     308   10280 '""' => sub { shift->name_lc },
38 24     24   174431 fallback => 1;
  24         45415  
  24         439  
39              
40             =head2 new
41              
42             my $column = Class::DBI::Column->new($column)
43              
44             A new object for this column.
45              
46             =cut
47              
48             sub new {
49 50     50 1 78 my ($class, $name) = @_;
50 50         344 return $class->SUPER::new(
51             {
52             name => $name,
53             _groups => {},
54             placeholder => '?'
55             }
56             );
57             }
58              
59 422     422 0 1038 sub name_lc { lc shift->name }
60              
61             sub add_group {
62 63     63 0 107 my ($self, $group) = @_;
63 63         317 $self->{_groups}->{$group} = 1;
64             }
65              
66             sub groups {
67 34     34 0 45 my $self = shift;
68 34         37 my %groups = %{ $self->{_groups} };
  34         143  
69 34 100       101 delete $groups{All} if keys %groups > 1;
70 34         229 return keys %groups;
71             }
72              
73             sub in_database {
74 32     32 0 76 return !scalar grep $_ eq "TEMP", shift->groups;
75             }
76              
77             1;