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   my $rs_class = $self->resultset_class;
  70   eval "use $rs_class;";
  71   return $rs_class->new($self);
  72 }
  73
  74 =head2 has_column
  75
  76   if ($obj->has_column($col)) { ... }
  77
  78 Returns 1 if the table has a column of this name, 0 otherwise.
  79
  80 =cut
  81
  82 sub has_column {
  83   my ($self, $column) = @_;
  84   return exists $self->_columns->{$column};
  85 }
  86
  87 =head2 column_info
  88
  89   my $info = $obj->column_info($col);
  90
  91 Returns the column metadata hashref for a column.
  92
  93 =cut
  94
  95 sub column_info {
  96   my ($self, $column) = @_;
  97   croak "No such column $column" unless exists $self->_columns->{$column};
  98   return $self->_columns->{$column};
  99 }
 100
 101 =head2 columns
 102
 103   my @column_names = $obj->columns;
 104
 105 =cut
 106
 107 sub columns {
 108   croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
 109   return keys %{shift->_columns};
 110 }
 111
 112 =head2 set_primary_key(@cols)
 113
 114 Defines one or more columns as primary key for this table. Should be
 115 called after C<add_columns>.
 116
 117 =cut
 118
 119 sub set_primary_key {
 120   my ($self, @cols) = @_;
 121   # check if primary key columns are valid columns
 122   for (@cols) {
 123     $self->throw("No such column $_ on table ".$self->name)
 124       unless $self->has_column($_);
 125   }
 126   $self->_primaries(\@cols);
 127 }
 128
 129 =head2 primary_columns
 130
 131 Read-only accessor which returns the list of primary keys.
 132
 133 =cut
 134
 135 sub primary_columns {
 136   return @{shift->_primaries||[]};
 137 }
 138
 139
 140 1;
 141
 142 =head1 AUTHORS
 143
 144 Matt S. Trout <mst@shadowcatsystems.co.uk>
 145
 146 =head1 LICENSE
 147
 148 You may distribute this code under the same terms as Perl itself.
 149
 150 =cut
 151