lib/DBIx/Class/Table.pm

   1 package DBIx::Class::Table;
   2
   3 use strict;
   4 use warnings;
   5
   6 use DBIx::Class::ResultSet;
   7
   8 use Carp qw/croak/;
   9
  10 use base qw/DBIx::Class/;
  11 __PACKAGE__->load_components(qw/AccessorGroup/);
  12
  13 __PACKAGE__->mk_group_accessors('simple' =>
  14   qw/_columns _primaries name resultset_class result_class storage/);
  15
  16 =head1 NAME
  17
  18 DBIx::Class::Table - Table object
  19
  20 =head1 SYNOPSIS
  21
  22 =head1 DESCRIPTION
  23
  24 This class is responsible for defining and doing table-level operations on
  25 L<DBIx::Class> classes.
  26
  27 =head1 METHODS
  28
  29 =cut
  30
  31 sub new {
  32   my ($class, $attrs) = @_;
  33   $class = ref $class if ref $class;
  34   my $new = bless({ %{$attrs || {}} }, $class);
  35   $new->{resultset_class} ||= 'DBIx::Class::ResultSet';
  36   $new->{_columns} ||= {};
  37   $new->{name} ||= "!!NAME NOT SET!!";
  38   return $new;
  39 }
  40
  41 sub add_columns {
  42   my ($self, @cols) = @_;
  43   while (my $col = shift @cols) {
  44     $self->_columns->{$col} = (ref $cols[0] ? shift : {});
  45   }
  46 }
  47
  48 *add_column = \&add_columns;
  49
  50 =head2 add_columns
  51
  52   $table->add_columns(qw/col1 col2 col3/);
  53
  54   $table->add_columns('col1' => \%col1_info, 'col2' => \%col2_info, ...);
  55
  56 Adds columns to the table object. If supplied key => hashref pairs uses
  57 the hashref as the column_info for that column.
  58
  59 =head2 add_column
  60
  61   $table->add_column('col' => \%info?);
  62
  63 Convenience alias to add_columns
  64
  65 =cut
  66
  67 sub resultset {
  68   my $self = shift;
  69   return $self->{resultset} ||= $self->resultset_class->new($self);
  70 }
  71
  72 =head2 has_column
  73
  74   if ($obj->has_column($col)) { ... }
  75
  76 Returns 1 if the table has a column of this name, 0 otherwise.
  77
  78 =cut
  79
  80 sub has_column {
  81   my ($self, $column) = @_;
  82   return exists $self->_columns->{$column};
  83 }
  84
  85 =head2 column_info
  86
  87   my $info = $obj->column_info($col);
  88
  89 Returns the column metadata hashref for a column.
  90
  91 =cut
  92
  93 sub column_info {
  94   my ($self, $column) = @_;
  95   croak "No such column $column" unless exists $self->_columns->{$column};
  96   return $self->_columns->{$column};
  97 }
  98
  99 =head2 columns
 100
 101   my @column_names = $obj->columns;
 102
 103 =cut
 104
 105 sub columns {
 106   croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
 107   return keys %{shift->_columns};
 108 }
 109
 110 =head2 set_primary_key(@cols)
 111
 112 Defines one or more columns as primary key for this table. Should be
 113 called after C<add_columns>.
 114
 115 =cut
 116
 117 sub set_primary_key {
 118   my ($self, @cols) = @_;
 119   # check if primary key columns are valid columns
 120   for (@cols) {
 121     $self->throw("No such column $_ on table ".$self->name)
 122       unless $self->has_column($_);
 123   }
 124   $self->_primaries(\@cols);
 125 }
 126
 127 =head2 primary_columns
 128
 129 Read-only accessor which returns the list of primary keys.
 130
 131 =cut
 132
 133 sub primary_columns {
 134   return @{shift->_primaries||[]};
 135 }
 136
 137 =head2 from
 138
 139 Returns the FROM entry for the table (i.e. the table name)
 140
 141 =cut
 142
 143 sub from { return shift->name(@_); }
 144
 145
 146 1;
 147
 148 =head1 AUTHORS
 149
 150 Matt S. Trout <mst@shadowcatsystems.co.uk>
 151
 152 =head1 LICENSE
 153
 154 You may distribute this code under the same terms as Perl itself.
 155
 156 =cut
 157