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